3
I have a simple process where a text file arrives by email and I must save it at a certain location within a folder whose name is a date that is within this file. With this in mind I developed the code below that makes the following process:
1) Through an email rule Outlook checks whether the sender of the message is the one selected and if so, executes the code 2) The code saves the attachment in a folder called "temp" 3) The code reads the second line of the saved file where a date is located 4) The Code renames this folder "temp" to the date read in the file
The problem is that when the code tries to rename the folder it shows the 70 code error message (Permission denied).
It is possible to rename a folder with files inside using VBA (Outlook)?
Code:
Public Sub SalvarAnexo(Item)
Dim Atmt As Attachment
Dim FileName As String
Dim objFSO As Object
Dim objFile As Object
Dim strData As String
Dim caminhoTemp As String
Dim caminhoFinal As String
Dim caminhoFtp As String
Dim fdr
'MsgBox "Mensagem Recebida de " & Item.Sender & "!"
'caminhoTemp = "Z:\MIS\08.Bases\01.big data\01.PF\2015\temp"
'caminhoFinal = "Z:\MIS\08.Bases\01.big data\01.PF\2015\"
'caminhoFtp = "ftp://upgrademefiles.bigdatacorp.com.br/Arquivos%20TXT/PF/"
caminhoTemp = "C:\Users\caio.pirino\Documents\temp"
caminhoFinal = "C:\Users\caio.pirino\Documents\"
caminhoFtp = "C:\Users\caio.pirino\Documents\SalvaAuto\temp"
Call CriaDiretorio(caminhoTemp)
For Each Atmt In Item.Attachments
If Right$(Atmt.FileName, 3) = "TXT" Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
FileName = caminhoTemp & "\" & Atmt.FileName
Atmt.SaveAsFile FileName
Set objFile = objFSO.OpenTextFile(FileName, 1)
strData = objFile.ReadLine
strData = objFile.ReadLine
strData = Left$(strData, 10)
strData = Replace(strData, "-", "")
caminhoFinal = caminhoFinal & strData
'Call CriaDiretorio(caminhoFinal)
'Call Copy_Folder(caminhoTemp, caminhoFinal)
'Call CriaDiretorio(caminhoFtp)
'Call Copy_Folder(caminhoFinal, caminhoFtp)
'Call RenameFileOrDir(caminhoTemp, caminhoFinal)
On Error GoTo PROC_ERR
Set fdr = objFSO.GetFolder(caminhoTemp)
fdr.Name = strData
objFile.Close
MsgBox "Your date is " & strData
End If
Next Atmt
PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , "RenameFileOrDir"
End Sub
'requires reference to Microsoft Scripting Runtime
Sub CriaDiretorio(strCaminho As String)
Dim strComp As String, strPart As String
If Not DiretorioExiste(strCaminho) Then
DiretorioCriado strCaminho
End If
End Sub
Function DiretorioCriado(ByVal caminho As String) As Boolean
DiretorioCriado = True
Dim FSO As New FileSystemObject
If DiretorioExiste(caminho) Then
Exit Function
Else
On Error GoTo DeadInTheWater
FSO.CreateFolder caminho
Exit Function
End If
DeadInTheWater:
MsgBox "A pasta não pode ser criada no caminho: " & caminho & ". Check se o caminho esta correto."
DiretorioCriado = False
Exit Function
End Function
Function DiretorioExiste(ByVal caminho As String) As Boolean
DiretorioExiste = False
Dim FSO As New FileSystemObject
If FSO.FileExists(caminho) Then DiretorioExiste = True
End Function