Why will macro will move pdfs and xlsxs but not msgs?
Hello!
Hello!
I've been trying to use a macro to COPY emails that have attachments from one location to another without success. I've had success using this macro to move pdf and xlsx files but not with emails that have attachments. The person who set this up is no longer on my team ( :crying:) but here's how it works:
Column A is the destination location
Column B is a search formula that looks into column C to determine column A (insignificant to this question)
Column C is the name of the file to be copied to destination location
Column D is the location of the file to be copied to destination location
I don't get a run-time error or anything because this macro is set up to move hundreds of files, and the ones that error are listed on a different sheet. The error I am getting is "bad file name or number." I know the file name is accurate because I can copy and paste the path from the workbook into file explorer and it opens. I have the "" at the end of everything too. As it is set up now, I can move xlsx and pdfs, just not the emails with attachments. The fact that it's not just a straight file (it has an attachment) might be the issue I am running into, but I'm hoping this can be modified for it to work, or that there is a different solution.
I'd also like to note that the emails I am trying to move are .msg files that are saved on the network - I'm not trying to move them straight from outlook
Any help is greatly appreciated!
Code:
Sub Copyfilefromto()
Dim mycheck As VbMsgBoxResult
mycheck = MsgBox("Do you want to start the Copy Program ", vbYesNo)
If mycheck = vbNo Then
Exit Sub
End If
MsgBox "This will take time - More files the longer it will take"
Dim a As Long, x As Long
Dim FilePath As String
Dim FileName As String
Dim ErrCount As Long
ErrCount = 1
x = Worksheets("Query").Cells(Rows.Count, 3).End(xlUp).Row
For a = 4 To x
FilePath = Worksheets("Query").Cells(a, 4)
FileName = Worksheets("Query").Cells(a, 3)
On Error GoTo ErrorHandler
Call GetFileType(FileName, FilePath, a)
FileCopy Worksheets("Query").Cells(a, 4) & Worksheets("Query").Cells(a, 3), Worksheets("Query").Cells(a, 1) & NewName
Next a
MsgBox (Str(x - 3) & " Files Copied to Destinations")
Cells(2, 5).Value = x - 3
Exit Sub
ErrorHandler:
Worksheets("ErrMsgs").Activate
Cells(ErrCount, 1).Value = FileName
Cells(ErrCount, 2).Value = Err.Description
Worksheets("Query").Activate
ErrCount = ErrCount + 1
Resume Next
End Sub
