MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    [Resolvido]Erro desconhecido ao incluir arquivos em zip via VBA

    Kebao10
    Kebao10
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 80
    Registrado : 16/07/2011

    [Resolvido]Erro desconhecido ao incluir arquivos em zip via VBA Empty [Resolvido]Erro desconhecido ao incluir arquivos em zip via VBA

    Mensagem  Kebao10 21/2/2022, 23:16

    Saudações a todos estou com um problema que não consigo identificar em uma adaptação de um código do mestre JPaulo

    Código:
    Private Sub btGerar_Click()
    Dim caminhoXml As String
    Dim arqFerias, arqFuncionarios, arqSecretaria, arqFuncoes As String

    'caminho para exportação
    caminhoXml = DLookup("caminhoXml", "tblConfig")
    If Right(caminhoXml, 1) <> "\" Then
    caminhoXml = caminhoXml & "\"
    End If

    'nomes de arquivos
    arqFerias = caminhoXml & "ferias.xml"
    arqFuncionarios = caminhoXml & "funcionarios.xml"
    arqSecretaria = caminhoXml & "secretarias.xml"
    arqFuncoes = caminhoXml & "funcoes.xml"

    'exporta xml
    Application.ExportXML acExportQuery, "ferias", arqFerias, , , , acUTF8, , "mesInc=" & Me.cboMesInc.Column(0) & " and anoInc=" & Me.txtAno.Value
    Application.ExportXML acExportQuery, "funcionario", arqFuncionarios, , , , acUTF8
    Application.ExportXML acExportQuery, "secretaria", arqSecretaria, , , , acUTF8
    Application.ExportXML acExportQuery, "funcao", arqFuncoes, , , , acUTF8

    'zipa arquivos
    Call ZipaXml(arqFerias, arqFuncionarios, arqSecretaria, arqFuncoes)


    End Sub

    Function ZipaXml(ferias, funcionarios, secretarias, funcoes)
    'Criado pelo meu amigo e colega Raw do Canadá
    'Adaptado por JPaulo ® Maximo Access
    Dim strDate As String, DefPath As String
    Dim oApp As Object
    Dim FileNameZip
    Dim nomeArq As String

    'arquivo zip
    nomeArq = Me.cboMesInc.Column(0) & "-" & Me.txtAno.Value
    FileNameZip = DLookup("caminhoXml", "tblConfig") & nomeArq & ".zip"

    'cria o arquivo zip
    CriaNovoZip (FileNameZip)
    Set oApp = CreateObject("Shell.Application")

    'add arquivos ao zip
    oApp.NameSpace(FileNameZip).CopyHere ferias
    oApp.NameSpace(FileNameZip).CopyHere funcionarios
    oApp.NameSpace(FileNameZip).CopyHere secretarias
    oApp.NameSpace(FileNameZip).CopyHere funcoes

    'sucesso
    MsgBox "Criado com Sucesso em: " & FileNameZip
    Set oApp = Nothing


    'deleta os xml
    Kill ferias
    Kill funcionarios
    Kill secretarias
    Kill funcoes


    Exit Function
    End Function


    Public Sub CriaNovoZip(sPath)
    'Criado pelo meu amigo e colega Raw do Canada
    'Adaptado por JPaulo ? Maximo Access
    Dim ofso, arrHex, sBin, i, Zip
    On Error Resume Next
    Set ofso = CreateObject("Scripting.FileSystemObject")
    arrHex = Array(80, 75, 5, 6, 0, 0, 0, _
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
    For i = 0 To UBound(arrHex)
    sBin = sBin & Chr(arrHex(i))
    Next
    On Error Resume Next
    With ofso.CreateTextFile(sPath, True)
    .Write sBin
    .Close
    End With
    Exit Sub
    End Sub


    Não sei por que ele não adiciona o ultimo arquivo funcoes.xml já verifiquei ele está sendo criado corretamente e o caminho tbm está correto só não adiciona ao arquivo .zip alguém poderia me ajudar a achar o erro não estou conseguindo identificar.

    desde já muito agradecido a todos
    Kebao10
    Kebao10
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 80
    Registrado : 16/07/2011

    [Resolvido]Erro desconhecido ao incluir arquivos em zip via VBA Empty Re: [Resolvido]Erro desconhecido ao incluir arquivos em zip via VBA

    Mensagem  Kebao10 22/2/2022, 11:29

    Resolvido foi só o "as string" sobrando na 3 linha de código

      Data/hora atual: 6/10/2022, 08:06