简化条件 VBA 代码 Microsoft Access
Simplify Conditional VBA Code Microsoft Access
我是 MS Access 和 VBA 代码的新手,但我一直很好地处理我的需求。下面发布的代码是我让点击事件正常工作的唯一方法。为了从多个表中打印出当前记录(邮件合并),需要填写一些字段。所以在实际打印输出代码之前,我插入了以下代码。有更好的方法吗?只是感觉我做的方式不对。
If IsNull(Screen.ActiveForm![Nome]) Then
MsgBox "Preencher o Nome do Cliente."
Screen.ActiveForm![Nome].SetFocus
Else
If IsNull(Screen.ActiveForm![Gênero]) Then
MsgBox "Preencher o Gênero do Cliente."
Screen.ActiveForm![Gênero].SetFocus
Else
If IsNull(Screen.ActiveForm![Estado Civíl]) Then
MsgBox "Preencher o Estado Civíl do Cliente."
Screen.ActiveForm![cboecivil].SetFocus
Else
If IsNull(Screen.ActiveForm![Profissão]) Then
MsgBox "Preencher a Profissão do Cliente."
Screen.ActiveForm![Profissão].SetFocus
Else
If IsNull(Screen.ActiveForm![CEP]) Then
MsgBox "Preencher o CEP do Cliente."
Screen.ActiveForm![CEP].SetFocus
Else
If IsNull(Screen.ActiveForm![Endereço]) Then
MsgBox "Preencher o nome da Rua do Cliente."
Screen.ActiveForm![Endereço].SetFocus
Else
If IsNull(Screen.ActiveForm![Número]) Then
MsgBox "Preencher o Número da Rua do Cliente."
Screen.ActiveForm![Número].SetFocus
Else
If IsNull(Screen.ActiveForm![Cidade]) Then
MsgBox "Preencher a Cidade do Cliente."
Screen.ActiveForm![Cidade].SetFocus
Else
If IsNull(Screen.ActiveForm![UF]) Then
MsgBox "Preencher o Estado do Cliente."
Screen.ActiveForm![UF].SetFocus
Else
If IsNull(Screen.ActiveForm![Bairro]) Then
MsgBox "Preencher o Bairro do Cliente."
Screen.ActiveForm![Bairro].SetFocus
Else
If IsNull(Screen.ActiveForm![Complemento]) Then
MsgBox "Preencher o Complemento do Endereço do Cliente."
Screen.ActiveForm![Complemento].SetFocus
Else
If IsNull(Forms("Painel de Controle").sftblCPF.Form.CPF) Then
MsgBox "Preencher o CPF do Cliente."
Forms("Painel de Controle").sftblCPF.Form.CPF.SetFocus
Else
If IsNull(Forms("Painel de Controle").sftblRG.Form.Número) Then
MsgBox "Preencher o Número do RG do Cliente."
Forms("Painel de Controle").sftblRG.Form.Número.SetFocus
Else
If IsNull(Forms("Painel de Controle").sftblRG.Form.Série) Then
MsgBox "Preencher a Série do RG do Cliente."
Forms("Painel de Controle").sftblRG.Form.Série.SetFocus
Else
If IsNull(Forms("Painel de Controle").sftblRG.Form.[Orgão Emissor]) Then
MsgBox "Preencher o Orgão Emissor do RG do Cliente."
Forms("Painel de Controle").sftblRG.Form.[Orgão Emissor].SetFocus
Else
If Forms("Painel de Controle").sftblCPF.Form.[Principal?] = False Then
MsgBox "Marcar o CPF Principal do Cliente."
Forms("Painel de Controle").sftblCPF.Form.[Principal?].SetFocus
Else
If Forms("Painel de Controle").sftblRG.Form.[Principal?] = False Then
MsgBox "Marcar o RG Principal do Cliente."
Forms("Painel de Controle").sftblRG.Form.[Principal?].SetFocus
Else
'MailMerge code inserted Here.
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
将所有字段名放入一个数组
Dim fieldNames As Variant
Private Sub Form_Load()
fieldNames = Array("Nome", "Gênero", "Estado Civíl", "Profissão", ...)
End Sub
然后使用循环进行检查
Dim fieldName As String
Dim i As Long
For i = LBound(fieldNames) To UBound(fieldNames)
fieldName = fieldNames(i)
If IsNull(Screen.ActiveForm(fieldName).Value) Then
MsgBox "Preencher o " & fieldName & " do Cliente."
Screen.ActiveForm(fieldName).SetFocus
Exit Sub
End If
Next i
如果您需要单独撰写的消息,您可以使用第二个包含消息的数组:
Dim fieldNames As Variant
Dim messages As Variant
Private Sub Form_Load()
fieldNames = Array("Nome", "Gênero", "Estado Civíl", "Profissão", ...)
messages = Array("Preencher o Nome do Cliente.", "Preencher o Gênero ...", ...)
End Sub
然后再次使用循环进行检查
Dim fieldName As String
Dim i As Long
For i = LBound(fieldNames) To UBound(fieldNames)
fieldName = fieldNames(i)
If IsNull(Screen.ActiveForm(fieldName).Value) Then
MsgBox messages(i)
Screen.ActiveForm(fieldName).SetFocus
Exit Sub
End If
Next i
顺便说一句,您可以使用 ElseIf
而不是 Else
后跟 If
。这将链接条件而不是嵌套它们
If IsNull(Screen.ActiveForm![Nome]) Then
MsgBox "Preencher o Nome do Cliente."
Screen.ActiveForm![Nome].SetFocus
ElseIf IsNull(Screen.ActiveForm![Gênero]) Then
MsgBox "Preencher o Gênero do Cliente."
Screen.ActiveForm![Gênero].SetFocus
ElseIf IsNull(Screen.ActiveForm![Estado Civíl]) Then
MsgBox "Preencher o Estado Civíl do Cliente."
Screen.ActiveForm![cboecivil].SetFocus
ElseIf IsNull(Screen.ActiveForm![Profissão]) Then
MsgBox "Preencher a Profissão do Cliente."
Screen.ActiveForm![Profissão].SetFocus
...
End If
如果您 fields themselves required on the table then the record can't be saved until it is completed. If there are fields that are required at different steps, make sure the tables are normalized 的方式使得每个步骤都没有不同步骤所需的必填字段。
当需要在一个地方制作包含所有必填字段的表单时,进行一个查询,从一个查询所需的所有表中提取所有字段。将表单基于该查询。您可以编辑 properly formed query 中的字段,这样 就可以正常工作 。
一旦您以这种方式正确定义了后端,前端界面就会内置警告,如果缺少必填字段,则不允许保存表单。总共需要零个 VBA 代码才能使其正常工作。
最终您将拥有一个更加规范化的数据库,该数据库具有更好的安全控制以避免无效状态。您还会发现适当 indexing, relating, and constraining 表格带来的性能改进。
首先感谢大家的讲解。你不知道它有多大帮助。我最终使用了 Olivier 建议的第二个例子。由于提示文字多样化的需要,无法使用第一个选项
这些字段对于数据库来说并不是必需的,但对于我构建的用于将数据导出到 MailMerge 文档的一些按钮事件来说,它们是必需的。顺便说一句,这真的很难做到,因为我有来自多个 tables(作为子表单)的数据,而且我只需要合并当前记录。为了让它工作,我创建了一个索引到表单当前 ClientID 的参数查询,然后 VBA 代码将该数据插入到预先创建的单个记录 table 中,我的 MailMerged 文档从中提取信息。如果尚未创建,我还使用代码创建了 ClientFolder 的名称。我不知道这个过程对数据库是否安全,但我真的找不到任何其他方法来做到这一点。我将post下面的完整代码,以便其他人可以检查和使用它。
HackSlash,我对这个表单很费劲,因为每次我尝试使用查询作为源时,我都无法对其进行编辑。因此,我使用了包含最需要的信息和大量子表单的 table(出于两个原因)。首先,我在表单上需要的一些字段具有一对多关系(如 ClientComments、ClientePhoneNumbers 等),其次,因为我不知道我能够编辑查询源,所以我不得不使用子表单作为文本字段将相关信息放置在表单上。我一定会查看您 post 编辑的文章,并尝试通过查询获取此表单。再来一次,非常感谢!
Private Sub cmdProcuração_Click()
If IsNull(Screen.ActiveForm![Nome]) Then
MsgBox "Preencher o Nome do Cliente."
Screen.ActiveForm![Nome].SetFocus
ElseIf IsNull(Screen.ActiveForm![Gênero]) Then
MsgBox "Preencher o Gênero do Cliente."
Screen.ActiveForm![Gênero].SetFocus
ElseIf IsNull(Screen.ActiveForm![Estado Civíl]) Then
MsgBox "Preencher o Estado Civíl do Cliente."
Screen.ActiveForm![cboecivil].SetFocus
ElseIf IsNull(Screen.ActiveForm![Profissão]) Then
MsgBox "Preencher a Profissão do Cliente."
Screen.ActiveForm![Profissão].SetFocus
ElseIf IsNull(Screen.ActiveForm![CEP]) Then
MsgBox "Preencher o CEP do Cliente."
Screen.ActiveForm![CEP].SetFocus
ElseIf IsNull(Screen.ActiveForm![Endereço]) Then
MsgBox "Preencher o nome da Rua do Cliente."
Screen.ActiveForm![Endereço].SetFocus
ElseIf IsNull(Screen.ActiveForm![Número]) Then
MsgBox "Preencher o Número da Rua do Cliente."
Screen.ActiveForm![Número].SetFocus
ElseIf IsNull(Screen.ActiveForm![Cidade]) Then
MsgBox "Preencher a Cidade do Cliente."
Screen.ActiveForm![Cidade].SetFocus
ElseIf IsNull(Screen.ActiveForm![UF]) Then
MsgBox "Preencher o Estado do Cliente."
Screen.ActiveForm![UF].SetFocus
ElseIf IsNull(Screen.ActiveForm![Bairro]) Then
MsgBox "Preencher o Bairro do Cliente."
Screen.ActiveForm![Bairro].SetFocus
ElseIf IsNull(Screen.ActiveForm![Complemento]) Then
MsgBox "Preencher o Complemento do Endereço do Cliente."
Screen.ActiveForm![Complemento].SetFocus
ElseIf IsNull(Forms("Painel de Controle").sftblCPF.Form.CPF) Then
MsgBox "Preencher o CPF do Cliente."
Forms("Painel de Controle").sftblCPF.Form.CPF.SetFocus
ElseIf IsNull(Forms("Painel de Controle").sftblRG.Form.Número) Then
MsgBox "Preencher o Número do RG do Cliente."
Forms("Painel de Controle").sftblRG.Form.Número.SetFocus
ElseIf IsNull(Forms("Painel de Controle").sftblRG.Form.Série) Then
MsgBox "Preencher a Série do RG do Cliente."
Forms("Painel de Controle").sftblRG.Form.Série.SetFocus
ElseIf IsNull(Forms("Painel de Controle").sftblRG.Form.[Orgão Emissor]) Then
MsgBox "Preencher o Orgão Emissor do RG do Cliente."
Forms("Painel de Controle").sftblRG.Form.[Orgão Emissor].SetFocus
ElseIf Forms("Painel de Controle").sftblCPF.Form.[Principal?] = False Then
MsgBox "Marcar o CPF Principal do Cliente."
Forms("Painel de Controle").sftblCPF.Form.[Principal?].SetFocus
ElseIf Forms("Painel de Controle").sftblRG.Form.[Principal?] = False Then
MsgBox "Marcar o RG Principal do Cliente."
Forms("Painel de Controle").sftblRG.Form.[Principal?].SetFocus
Else
On Error GoTo ErrorHandler
'A seguir comandos para modificar a tabela existente com os dados atuais do formulário (Organizados em uma Consulta)
DoCmd.SetWarnings False
DoCmd.RunSQL "SELECT * INTO [tblExportarDocumentos] FROM [Exportar Contatos]" '(FROM QUERY)
DoCmd.SetWarnings True
Dim strSql As String
'Instrução SQL direto da tabela criada
strSql = "SELECT * FROM [tblExportarDocumentos]"
Dim strDocumentName As String 'Nome do Documento Template com a subpasta
strDocumentName = "\Documentos\Procuração RCT.docx"
Dim strNewName As String 'Nome usado para Salvar o Documento
strNewName = "Procuração - " & Nome.Value
Call OpenMergedDoc(strDocumentName, strSql, strNewName)
Exit Sub
ErrorHandler:
MsgBox "Error #" & Err.Number & " occurred. " & Err.Description,
vbOKOnly, "Error"
Exit Sub
End If
End Sub
Private Sub OpenMergedDoc(strDocName As String, strSql As String, s
trMergedDocName As String)
On Error GoTo WordError
Const strDir As String = "C:\Users\Jcnra\Documents\Banco de Dados RCT"
'Localização da pasta com o Banco de Dados
Dim objWord As New Word.Application
Dim objDoc As Word.Document
objWord.Application.Visible = True
Set objDoc = objWord.Documents.Open(strDir & strDocName)
objWord.Application.Visible = True
'A seguir, a função do Mail Merge. Em Name: Colocar o endereço exato do arquivo do Banco de Dados
'Em SQLStatement: Colocar a mesma função sql acima
objDoc.MailMerge.OpenDataSource _
Name:="C:\Users\Jcnra\Documents\Banco de Dados RCT\Backup Banco de
Dados RCT.accdb", _
LinkToSource:=True, AddToRecentFiles:=False, _
Connection:="", _
SQLStatement:="SELECT * FROM [tblExportarDocumentos]"
'A seguir, condição para criar pastas no diretório, caso já não existam
If Dir(strDir & "\Clientes\" & Nome.Value, vbDirectory) = "" Then
MkDir (strDir & "\Clientes\" & Nome.Value)
Else
End If
objDoc.MailMerge.Destination = wdSendToNewDocument
objDoc.MailMerge.Execute
'Comando para salvar o Documento criado
objWord.Application.Documents(1).SaveAs (strDir & "\Clientes\" &
Nome.Value & "\" & strMergedDocName & ".docx")
objWord.Application.Documents(2).Close wdDoNotSaveChanges
objWord.Visible = True
objWord.Activate
objWord.WindowState = wdWindowStateMaximize
'Liberar as variáveis
Set objWord = Nothing
Set objDoc = Nothing
Exit Sub
WordError:
MsgBox "Err #" & Err.Number & " occurred." & Err.Description,
vbOKOnly, "Word Error"
objWord.Quit
End Sub
我是 MS Access 和 VBA 代码的新手,但我一直很好地处理我的需求。下面发布的代码是我让点击事件正常工作的唯一方法。为了从多个表中打印出当前记录(邮件合并),需要填写一些字段。所以在实际打印输出代码之前,我插入了以下代码。有更好的方法吗?只是感觉我做的方式不对。
If IsNull(Screen.ActiveForm![Nome]) Then
MsgBox "Preencher o Nome do Cliente."
Screen.ActiveForm![Nome].SetFocus
Else
If IsNull(Screen.ActiveForm![Gênero]) Then
MsgBox "Preencher o Gênero do Cliente."
Screen.ActiveForm![Gênero].SetFocus
Else
If IsNull(Screen.ActiveForm![Estado Civíl]) Then
MsgBox "Preencher o Estado Civíl do Cliente."
Screen.ActiveForm![cboecivil].SetFocus
Else
If IsNull(Screen.ActiveForm![Profissão]) Then
MsgBox "Preencher a Profissão do Cliente."
Screen.ActiveForm![Profissão].SetFocus
Else
If IsNull(Screen.ActiveForm![CEP]) Then
MsgBox "Preencher o CEP do Cliente."
Screen.ActiveForm![CEP].SetFocus
Else
If IsNull(Screen.ActiveForm![Endereço]) Then
MsgBox "Preencher o nome da Rua do Cliente."
Screen.ActiveForm![Endereço].SetFocus
Else
If IsNull(Screen.ActiveForm![Número]) Then
MsgBox "Preencher o Número da Rua do Cliente."
Screen.ActiveForm![Número].SetFocus
Else
If IsNull(Screen.ActiveForm![Cidade]) Then
MsgBox "Preencher a Cidade do Cliente."
Screen.ActiveForm![Cidade].SetFocus
Else
If IsNull(Screen.ActiveForm![UF]) Then
MsgBox "Preencher o Estado do Cliente."
Screen.ActiveForm![UF].SetFocus
Else
If IsNull(Screen.ActiveForm![Bairro]) Then
MsgBox "Preencher o Bairro do Cliente."
Screen.ActiveForm![Bairro].SetFocus
Else
If IsNull(Screen.ActiveForm![Complemento]) Then
MsgBox "Preencher o Complemento do Endereço do Cliente."
Screen.ActiveForm![Complemento].SetFocus
Else
If IsNull(Forms("Painel de Controle").sftblCPF.Form.CPF) Then
MsgBox "Preencher o CPF do Cliente."
Forms("Painel de Controle").sftblCPF.Form.CPF.SetFocus
Else
If IsNull(Forms("Painel de Controle").sftblRG.Form.Número) Then
MsgBox "Preencher o Número do RG do Cliente."
Forms("Painel de Controle").sftblRG.Form.Número.SetFocus
Else
If IsNull(Forms("Painel de Controle").sftblRG.Form.Série) Then
MsgBox "Preencher a Série do RG do Cliente."
Forms("Painel de Controle").sftblRG.Form.Série.SetFocus
Else
If IsNull(Forms("Painel de Controle").sftblRG.Form.[Orgão Emissor]) Then
MsgBox "Preencher o Orgão Emissor do RG do Cliente."
Forms("Painel de Controle").sftblRG.Form.[Orgão Emissor].SetFocus
Else
If Forms("Painel de Controle").sftblCPF.Form.[Principal?] = False Then
MsgBox "Marcar o CPF Principal do Cliente."
Forms("Painel de Controle").sftblCPF.Form.[Principal?].SetFocus
Else
If Forms("Painel de Controle").sftblRG.Form.[Principal?] = False Then
MsgBox "Marcar o RG Principal do Cliente."
Forms("Painel de Controle").sftblRG.Form.[Principal?].SetFocus
Else
'MailMerge code inserted Here.
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
将所有字段名放入一个数组
Dim fieldNames As Variant
Private Sub Form_Load()
fieldNames = Array("Nome", "Gênero", "Estado Civíl", "Profissão", ...)
End Sub
然后使用循环进行检查
Dim fieldName As String
Dim i As Long
For i = LBound(fieldNames) To UBound(fieldNames)
fieldName = fieldNames(i)
If IsNull(Screen.ActiveForm(fieldName).Value) Then
MsgBox "Preencher o " & fieldName & " do Cliente."
Screen.ActiveForm(fieldName).SetFocus
Exit Sub
End If
Next i
如果您需要单独撰写的消息,您可以使用第二个包含消息的数组:
Dim fieldNames As Variant
Dim messages As Variant
Private Sub Form_Load()
fieldNames = Array("Nome", "Gênero", "Estado Civíl", "Profissão", ...)
messages = Array("Preencher o Nome do Cliente.", "Preencher o Gênero ...", ...)
End Sub
然后再次使用循环进行检查
Dim fieldName As String
Dim i As Long
For i = LBound(fieldNames) To UBound(fieldNames)
fieldName = fieldNames(i)
If IsNull(Screen.ActiveForm(fieldName).Value) Then
MsgBox messages(i)
Screen.ActiveForm(fieldName).SetFocus
Exit Sub
End If
Next i
顺便说一句,您可以使用 ElseIf
而不是 Else
后跟 If
。这将链接条件而不是嵌套它们
If IsNull(Screen.ActiveForm![Nome]) Then
MsgBox "Preencher o Nome do Cliente."
Screen.ActiveForm![Nome].SetFocus
ElseIf IsNull(Screen.ActiveForm![Gênero]) Then
MsgBox "Preencher o Gênero do Cliente."
Screen.ActiveForm![Gênero].SetFocus
ElseIf IsNull(Screen.ActiveForm![Estado Civíl]) Then
MsgBox "Preencher o Estado Civíl do Cliente."
Screen.ActiveForm![cboecivil].SetFocus
ElseIf IsNull(Screen.ActiveForm![Profissão]) Then
MsgBox "Preencher a Profissão do Cliente."
Screen.ActiveForm![Profissão].SetFocus
...
End If
如果您 fields themselves required on the table then the record can't be saved until it is completed. If there are fields that are required at different steps, make sure the tables are normalized 的方式使得每个步骤都没有不同步骤所需的必填字段。
当需要在一个地方制作包含所有必填字段的表单时,进行一个查询,从一个查询所需的所有表中提取所有字段。将表单基于该查询。您可以编辑 properly formed query 中的字段,这样 就可以正常工作 。
一旦您以这种方式正确定义了后端,前端界面就会内置警告,如果缺少必填字段,则不允许保存表单。总共需要零个 VBA 代码才能使其正常工作。
最终您将拥有一个更加规范化的数据库,该数据库具有更好的安全控制以避免无效状态。您还会发现适当 indexing, relating, and constraining 表格带来的性能改进。
首先感谢大家的讲解。你不知道它有多大帮助。我最终使用了 Olivier 建议的第二个例子。由于提示文字多样化的需要,无法使用第一个选项
这些字段对于数据库来说并不是必需的,但对于我构建的用于将数据导出到 MailMerge 文档的一些按钮事件来说,它们是必需的。顺便说一句,这真的很难做到,因为我有来自多个 tables(作为子表单)的数据,而且我只需要合并当前记录。为了让它工作,我创建了一个索引到表单当前 ClientID 的参数查询,然后 VBA 代码将该数据插入到预先创建的单个记录 table 中,我的 MailMerged 文档从中提取信息。如果尚未创建,我还使用代码创建了 ClientFolder 的名称。我不知道这个过程对数据库是否安全,但我真的找不到任何其他方法来做到这一点。我将post下面的完整代码,以便其他人可以检查和使用它。
HackSlash,我对这个表单很费劲,因为每次我尝试使用查询作为源时,我都无法对其进行编辑。因此,我使用了包含最需要的信息和大量子表单的 table(出于两个原因)。首先,我在表单上需要的一些字段具有一对多关系(如 ClientComments、ClientePhoneNumbers 等),其次,因为我不知道我能够编辑查询源,所以我不得不使用子表单作为文本字段将相关信息放置在表单上。我一定会查看您 post 编辑的文章,并尝试通过查询获取此表单。再来一次,非常感谢!
Private Sub cmdProcuração_Click()
If IsNull(Screen.ActiveForm![Nome]) Then
MsgBox "Preencher o Nome do Cliente."
Screen.ActiveForm![Nome].SetFocus
ElseIf IsNull(Screen.ActiveForm![Gênero]) Then
MsgBox "Preencher o Gênero do Cliente."
Screen.ActiveForm![Gênero].SetFocus
ElseIf IsNull(Screen.ActiveForm![Estado Civíl]) Then
MsgBox "Preencher o Estado Civíl do Cliente."
Screen.ActiveForm![cboecivil].SetFocus
ElseIf IsNull(Screen.ActiveForm![Profissão]) Then
MsgBox "Preencher a Profissão do Cliente."
Screen.ActiveForm![Profissão].SetFocus
ElseIf IsNull(Screen.ActiveForm![CEP]) Then
MsgBox "Preencher o CEP do Cliente."
Screen.ActiveForm![CEP].SetFocus
ElseIf IsNull(Screen.ActiveForm![Endereço]) Then
MsgBox "Preencher o nome da Rua do Cliente."
Screen.ActiveForm![Endereço].SetFocus
ElseIf IsNull(Screen.ActiveForm![Número]) Then
MsgBox "Preencher o Número da Rua do Cliente."
Screen.ActiveForm![Número].SetFocus
ElseIf IsNull(Screen.ActiveForm![Cidade]) Then
MsgBox "Preencher a Cidade do Cliente."
Screen.ActiveForm![Cidade].SetFocus
ElseIf IsNull(Screen.ActiveForm![UF]) Then
MsgBox "Preencher o Estado do Cliente."
Screen.ActiveForm![UF].SetFocus
ElseIf IsNull(Screen.ActiveForm![Bairro]) Then
MsgBox "Preencher o Bairro do Cliente."
Screen.ActiveForm![Bairro].SetFocus
ElseIf IsNull(Screen.ActiveForm![Complemento]) Then
MsgBox "Preencher o Complemento do Endereço do Cliente."
Screen.ActiveForm![Complemento].SetFocus
ElseIf IsNull(Forms("Painel de Controle").sftblCPF.Form.CPF) Then
MsgBox "Preencher o CPF do Cliente."
Forms("Painel de Controle").sftblCPF.Form.CPF.SetFocus
ElseIf IsNull(Forms("Painel de Controle").sftblRG.Form.Número) Then
MsgBox "Preencher o Número do RG do Cliente."
Forms("Painel de Controle").sftblRG.Form.Número.SetFocus
ElseIf IsNull(Forms("Painel de Controle").sftblRG.Form.Série) Then
MsgBox "Preencher a Série do RG do Cliente."
Forms("Painel de Controle").sftblRG.Form.Série.SetFocus
ElseIf IsNull(Forms("Painel de Controle").sftblRG.Form.[Orgão Emissor]) Then
MsgBox "Preencher o Orgão Emissor do RG do Cliente."
Forms("Painel de Controle").sftblRG.Form.[Orgão Emissor].SetFocus
ElseIf Forms("Painel de Controle").sftblCPF.Form.[Principal?] = False Then
MsgBox "Marcar o CPF Principal do Cliente."
Forms("Painel de Controle").sftblCPF.Form.[Principal?].SetFocus
ElseIf Forms("Painel de Controle").sftblRG.Form.[Principal?] = False Then
MsgBox "Marcar o RG Principal do Cliente."
Forms("Painel de Controle").sftblRG.Form.[Principal?].SetFocus
Else
On Error GoTo ErrorHandler
'A seguir comandos para modificar a tabela existente com os dados atuais do formulário (Organizados em uma Consulta)
DoCmd.SetWarnings False
DoCmd.RunSQL "SELECT * INTO [tblExportarDocumentos] FROM [Exportar Contatos]" '(FROM QUERY)
DoCmd.SetWarnings True
Dim strSql As String
'Instrução SQL direto da tabela criada
strSql = "SELECT * FROM [tblExportarDocumentos]"
Dim strDocumentName As String 'Nome do Documento Template com a subpasta
strDocumentName = "\Documentos\Procuração RCT.docx"
Dim strNewName As String 'Nome usado para Salvar o Documento
strNewName = "Procuração - " & Nome.Value
Call OpenMergedDoc(strDocumentName, strSql, strNewName)
Exit Sub
ErrorHandler:
MsgBox "Error #" & Err.Number & " occurred. " & Err.Description,
vbOKOnly, "Error"
Exit Sub
End If
End Sub
Private Sub OpenMergedDoc(strDocName As String, strSql As String, s
trMergedDocName As String)
On Error GoTo WordError
Const strDir As String = "C:\Users\Jcnra\Documents\Banco de Dados RCT"
'Localização da pasta com o Banco de Dados
Dim objWord As New Word.Application
Dim objDoc As Word.Document
objWord.Application.Visible = True
Set objDoc = objWord.Documents.Open(strDir & strDocName)
objWord.Application.Visible = True
'A seguir, a função do Mail Merge. Em Name: Colocar o endereço exato do arquivo do Banco de Dados
'Em SQLStatement: Colocar a mesma função sql acima
objDoc.MailMerge.OpenDataSource _
Name:="C:\Users\Jcnra\Documents\Banco de Dados RCT\Backup Banco de
Dados RCT.accdb", _
LinkToSource:=True, AddToRecentFiles:=False, _
Connection:="", _
SQLStatement:="SELECT * FROM [tblExportarDocumentos]"
'A seguir, condição para criar pastas no diretório, caso já não existam
If Dir(strDir & "\Clientes\" & Nome.Value, vbDirectory) = "" Then
MkDir (strDir & "\Clientes\" & Nome.Value)
Else
End If
objDoc.MailMerge.Destination = wdSendToNewDocument
objDoc.MailMerge.Execute
'Comando para salvar o Documento criado
objWord.Application.Documents(1).SaveAs (strDir & "\Clientes\" &
Nome.Value & "\" & strMergedDocName & ".docx")
objWord.Application.Documents(2).Close wdDoNotSaveChanges
objWord.Visible = True
objWord.Activate
objWord.WindowState = wdWindowStateMaximize
'Liberar as variáveis
Set objWord = Nothing
Set objDoc = Nothing
Exit Sub
WordError:
MsgBox "Err #" & Err.Number & " occurred." & Err.Description,
vbOKOnly, "Word Error"
objWord.Quit
End Sub