código para manipular arquivos no windows

Salve a todos,



tenho um código que gera um relatório, abre o Outlook, anexando este relatório e um outro arquivo que esta salvo em um pasta chamada "trabalhando" e salva o relatório em uma pasta chamada "enviados", gostaria de incrementar este código para que após anexar estes arquivos ao e-mail, criasse uma subpasta (nomeando-a com o mês anterior ) dentro da pasta "enviados", copiasse os arquivos das duas pastas colando nesta subpasta e apagasse os arquivos de suas pastas nativas.


Obrigado

Código:

'Indico o nome do arquivo pdf e o local que será gravado.
    strArquivo = "Relatório " & frmq!CboCentrodeCusto.Column(0) & " " & Format(DateAdd("m", -1, Date), "mmmm yyyy") & ".pdf"
    strLocal = CurrentProject.Path & "\enviados\" & strArquivo
    'Gera o pdf do relatório através do comando OutputTo.
    DoCmd.OutputTo acOutputReport, "Relatorioconvenio", acFormatPDF, strLocal
   
    'Indico o nome e o local onde se encontra a NF referente ao relatório
    strNF = "NF " & frmq!CboCentrodeCusto.Column(0) & " " & Format(DateAdd("m", -1, Date), "mmmm yyyy") & ".pdf"
    strLocalNF = CurrentProject.Path & "\trabalhando\" & strNF

tentando descascar meu próprio abacaxi, comecei a estudar o código, mas já estou com um problema, o trecho abaixo funciona perfeitamente se a subpasta não existe, já se ela existe me da...

erro 75 erro de aceso a caminho/arquivo

Código:

If Len(Dir(CurrentProject.Path & "\enviados\" & Format(DateAdd("m", -1, Date), "mmmm yyyy"))) > 0 Then
    MsgBox " Subpasta já existe "
    Else
    MkDir (CurrentProject.Path & "\enviados\" & Format(DateAdd("m", -1, Date), "mmmm yyyy"))
    End If

...pesquisando aqui no fórum li alguns tópicos de permissão de acesso, mas nenhum tópico com solução.


Aguardo ajuda


Fabio

Boa tarde,
Faça verificação se pasta existe
Só executar se pasta não existir

Código:

Function ExistePasta(Endereco As String) As Boolean
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '  código criado por Alexandre Neves, do Fórum MaximoAccess                                                '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim Fso
    Dim EnderecoPasta As String, Cont As Integer
   
    For Cont = Len(Endereco) To 1 Step -1
        If Right(Mid(Endereco, 1, Cont), 1) = "\" Then
            EnderecoPasta = Mid(Endereco, 1, Cont)
            Exit For
        End If
    Next
    Set Fso = CreateObject("Scripting.FileSystemObject")
    If (Fso.FolderExists(EnderecoPasta)) Then
        ExistePasta = True
    Else
        ExistePasta = False
    End If
    Set Fso = Nothing
End Function


Boa tarde Alexandre,


obrigado pela resposta,


o meu condigo completo esta dentro de uma Case, não sei como colocar ou chamar esta verificação dentro da rotina, peço até desculpas pela ignorância...

... se puder indicar o caminho.

observe também que o nome da subpasta mudara todo mês, será sempre nomeada com o nome do mes anterior e ano corrente

Código:

CurrentProject.Path & "\enviados\" & Format(DateAdd("m", -1, Date), "mmmm yyyy"

Código:

Case "btImprimirConsultaConvenio"
   
    Dim strArquivo As String
    Dim strNF As String
    Dim strLocal As String
    Dim strLocalNF As String
    Dim filtro As String
    Dim frmq As Form
    Dim strAtt As String
   
    Set frmq = forms!FormRelatorioConvenio
   
    If CurrentProject.AllForms("FormRelatorioConvenio").IsLoaded Then 'verifica se o formulário está aberto
    If Len(frmq!CboCliente & "") > 0 Then filtro = "cliente = '" & frmq!CboCliente.Column(1) & "'"
    If Len(frmq!CboMotoqueiro & "") > 0 Then filtro = "motoqueiro = '" & frmq!CboMotoqueiro.Column(1) & "'"
    If Len(frmq!CboCentrodeCusto & "") > 0 Then filtro = "centrodecusto = '" & frmq!CboCentrodeCusto.Column(0) & "'"

    If Len(frmq!DataInicial & "") > 0 And Len(frmq!DataFinal & "") > 0 Then
    If filtro = "" Then
    filtro = "tabelaconvenio.Data Between #" & Format(frmq!DataInicial, "mm/dd/yyyy") & "# AND #" & Format(frmq!DataFinal, "mm/dd/yyyy") & "#"
    Else
    filtro = filtro & " AND tabelaconvenio.Data Between #" & Format(frmq!DataInicial, "mm/dd/yyyy") & "# AND #" & Format(frmq!DataFinal, "mm/dd/yyyy") & "#"
   
    End If
    End If
    End If
   
    frmq!sfrmConsulta.Form.Filter = filtro
    frmq!sfrmConsulta.Form.FilterOn = True
   
    DoCmd.OpenReport "Relatorioconvenio", acViewPreview, , filtro
    DoCmd.Maximize
   
    'If Len(Dir(CurrentProject.Path & "\enviados\" & Format(DateAdd("m", -1, Date), "mmmm yyyy"))) > 0 Then
    'MsgBox " já existe "
    'Else
    'MkDir (CurrentProject.Path & "\enviados\" & Format(DateAdd("m", -1, Date), "mmmm yyyy"))
    'End If
   
    'Indico o nome do arquivo pdf e o local que será gravado.
    strArquivo = "Relatório " & frmq!CboCentrodeCusto.Column(0) & " " & Format(DateAdd("m", -1, Date), "mmmm yyyy") & ".pdf"
    strLocal = CurrentProject.Path & "\enviados\" & strArquivo
    'Gera o pdf do relatório através do comando OutputTo.
    DoCmd.OutputTo acOutputReport, "Relatorioconvenio", acFormatPDF, strLocal
   
    'Indico o nome e o local onde se encontra a NF referente ao relatório
    strNF = "NF " & frmq!CboCentrodeCusto.Column(0) & " " & Format(DateAdd("m", -1, Date), "mmmm yyyy") & ".pdf"
    strLocalNF = CurrentProject.Path & "\trabalhando\" & strNF
             
    'Similar ao abrir o Outlook
    Set objOut = CreateObject("Outlook.application")
    'Similar ao clicar no botão NOVO do Outlook
    Set objmail = objOut.CreateItem(olMailItem)
    'Similar ao clicar no botão ANEXO do Outlook
    Set objAnexo = objmail.Attachments
    'Adiciona o arquivo pdf no anexo, capturado da pasta enviados
    objAnexo.Add strLocal, olByValue, 1
    objAnexo.Add strLocalNF, olByValue, 1
   
    'Passando os valores do formulário exemplo para os itens de email
    objmail.To = frmq!CboCentrodeCusto.Column(2) 'destinatário
    objmail.Subject = "Atrix Express " & frmq!CboCentrodeCusto.Column(0) & " " & Format(DateAdd("m", -1, Date), "mmmm yyyy")
    objmail.Body = "Bom dia " & frmq!CboCentrodeCusto.Column(1) & "," & vbCrLf & vbCrLf & vbCrLf & "Segue fechamento de " & Format(DateAdd("m", -1, Date), "mmmm yyyy") & " para controle." & vbCrLf & vbCrLf & vbCrLf & "Atenciosamente" & vbCrLf & vbCrLf & vbCrLf & "Fabio Pradella"
   
    'Mostra o formulário de envio de email
    objmail.Display

    '-------------------------------------------------------
    'Tudo já foi entregue ao Outlook; então podemos esvaziar
    'a memória do computador usada pelas variáveis objeto.
    '-------------------------------------------------------
    Set objAnexo = Nothing
    Set objmail = Nothing
    Set objOut = Nothing
   
    DoCmd.Close

Veja agora

Código:

Case "btImprimirConsultaConvenio"
   
    Dim strArquivo As String
    Dim strNF As String
    Dim strLocal As String
    Dim strLocalNF As String
    Dim filtro As String
    Dim frmq As Form
    Dim strAtt As String
   
    Set frmq = Forms!FormRelatorioConvenio
   
    If CurrentProject.AllForms("FormRelatorioConvenio").IsLoaded Then 'verifica se o formulário está aberto
    If Len(frmq!CboCliente & "") > 0 Then filtro = "cliente = '" & frmq!CboCliente.Column(1) & "'"
    If Len(frmq!CboMotoqueiro & "") > 0 Then filtro = "motoqueiro = '" & frmq!CboMotoqueiro.Column(1) & "'"
    If Len(frmq!CboCentrodeCusto & "") > 0 Then filtro = "centrodecusto = '" & frmq!CboCentrodeCusto.Column(0) & "'"

    If Len(frmq!DataInicial & "") > 0 And Len(frmq!DataFinal & "") > 0 Then
    If filtro = "" Then
    filtro = "tabelaconvenio.Data Between #" & Format(frmq!DataInicial, "mm/dd/yyyy") & "# AND #" & Format(frmq!DataFinal, "mm/dd/yyyy") & "#"
    Else
    filtro = filtro & " AND tabelaconvenio.Data Between #" & Format(frmq!DataInicial, "mm/dd/yyyy") & "# AND #" & Format(frmq!DataFinal, "mm/dd/yyyy") & "#"
   
    End If
    End If
    End If
   
    frmq!sfrmConsulta.Form.Filter = filtro
    frmq!sfrmConsulta.Form.FilterOn = True
   
    DoCmd.OpenReport "Relatorioconvenio", acViewPreview, , filtro
    DoCmd.Maximize
   
    If Not ExistePasta(Dir(CurrentProject.path & "\enviados\" & Format(DateAdd("m", -1, Date), "mmmm yyyy"))) Then
        MkDir (CurrentProject.path & "\enviados\" & Format(DateAdd("m", -1, Date), "mmmm yyyy"))
    End If
   
    'Indico o nome do arquivo pdf e o local que será gravado.
    strArquivo = "Relatório " & frmq!CboCentrodeCusto.Column(0) & " " & Format(DateAdd("m", -1, Date), "mmmm yyyy") & ".pdf"
    strLocal = CurrentProject.path & "\enviados\" & strArquivo
    'Gera o pdf do relatório através do comando OutputTo.
    DoCmd.OutputTo acOutputReport, "Relatorioconvenio", acFormatPDF, strLocal
   
    'Indico o nome e o local onde se encontra a NF referente ao relatório
    strNF = "NF " & frmq!CboCentrodeCusto.Column(0) & " " & Format(DateAdd("m", -1, Date), "mmmm yyyy") & ".pdf"
    strLocalNF = CurrentProject.path & "\trabalhando\" & strNF
             
    'Similar ao abrir o Outlook
    Set objOut = CreateObject("Outlook.application")
    'Similar ao clicar no botão NOVO do Outlook
    Set objmail = objOut.CreateItem(olMailItem)
    'Similar ao clicar no botão ANEXO do Outlook
    Set objAnexo = objmail.Attachments
    'Adiciona o arquivo pdf no anexo, capturado da pasta enviados
    objAnexo.Add strLocal, olByValue, 1
    objAnexo.Add strLocalNF, olByValue, 1
   
    'Passando os valores do formulário exemplo para os itens de email
    objmail.To = frmq!CboCentrodeCusto.Column(2) 'destinatário
    objmail.Subject = "Atrix Express " & frmq!CboCentrodeCusto.Column(0) & " " & Format(DateAdd("m", -1, Date), "mmmm yyyy")
    objmail.Body = "Bom dia " & frmq!CboCentrodeCusto.Column(1) & "," & vbCrLf & vbCrLf & vbCrLf & "Segue fechamento de " & Format(DateAdd("m", -1, Date), "mmmm yyyy") & " para controle." & vbCrLf & vbCrLf & vbCrLf & "Atenciosamente" & vbCrLf & vbCrLf & vbCrLf & "Fabio Pradella"
   
    'Mostra o formulário de envio de email
    objmail.Display

    '-------------------------------------------------------
    'Tudo já foi entregue ao Outlook; então podemos esvaziar
    'a memória do computador usada pelas variáveis objeto.
    '-------------------------------------------------------
    Set objAnexo = Nothing
    Set objmail = Nothing
    Set objOut = Nothing
   
    DoCmd.Close


Alexandre,


dá até vergonha de ver como as vezes o código é simples, mas deu o mesmo erro 75: erro de aceso a caminho/arquivo, como citado acima...

...não seria a tal da permissão do windows bloqueando o acesso? li isto em algum tópico aqui no fórum enquanto pesquisava.


Aguardo


Obrigado


Fabio

Em que instrução aparece o erro? É na chamada da função que indiquei?

sim, suspendi todo o código e testei só este trecho, como no código que postei no inicio do tópico, ele ate cria a pasta, mas quando vou rodar o código pela segunda vez da este erro, voltando todo a instrução e suspendendo só este trecho, o código roda liso novamente.

Boa tarde,
Componha o código na totalidade, só assim confere a sua integridade

Boa noite Alexandre,


fiz todos os testes possíveis, só o trecho, na totalidade, infelizmente não funcionou, mas agradeço a ajuda mesmo assim.



Abraço



Fabio

Olá a todos,
Em que linha do codigo é que está a dar erro.
É ao copiar?
Teste diretamente para verificar permissões.
Abraço