Hello,
This problem has been posted here and in a few other forums a few other times.
I've tried editing previous codes and ended up in a blurb of "Man, I really don't know much about coding!"
Here's the deal: I got nearly 1500 .msg files, of which I need their date and subject, to subsequently rename these files based on that info. In order to get each message date and subject I've found this piece of code:
Sub GetMailInfo()
Dim MyOutlook As Outlook.Application
Dim msg As Outlook.MailItem
Dim x As Namespace
Dim Path As String
'Dim FileList As Variant
Set MyOutlook = New Outlook.Application
Set x = MyOutlook.GetNamespace("MAPI")
Path = "C:\Users\TEST 2"
FileList = GetFileList(Path + "*.msg")
Row = 1
While Row <= UBound(FileList) **CURRENT BUG STOPS HERE WITH TYPE 13 MISMATCH ERROR**
Set msg = x.OpenSharedItem(Path + FileList(Row))
Cells(Row + 1, 1) = msg.Subject
Cells(Row + 1, 2) = msg.SenderName
Cells(Row + 1, 3) = msg.SenderEmailAddress
Cells(Row + 1, 4) = msg.CC
Cells(Row + 1, 5) = msg.To
Cells(Row + 1, 6) = msg.SentOn
Cells(Row + 1, 7) = msg.Size
Row = Row + 1
Wend
End Sub
Sub test()
**WHEN RUNNING THIS... I'M GETTING RESULTS SAYING THAT THERE ARE NO FILES MATCHING... WHAT?***
Dim p As String, x As Variant
p = "C:/Users/TEST 2"
x = GetFileList(p + "*.msg")
Select Case IsArray(x)
Case True 'files found
MsgBox UBound(x)
Sheets("Sheet1").Range("A:A").Clear
For i = LBound(x) To UBound(x)
Sheets("Sheet1").Cells(i, 1).Value = x(i)
Next i
Case False 'no files found
MsgBox "No matching files"
End Select
End Sub
Function GetFileList(FileSpec As String) As Variant (another piece of code that was with the first part)
** I'm not sure if the error here is because I have no directory specified for FileSpec **
' Taken from Excel Tips From John Walkenbach: Getting A List Of File Names Using VBA
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False
Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
On Error GoTo NoFilesFound
FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound
' Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function
' Error handler
NoFilesFound:
GetFileList = False
End Function
HELP?
Anything that could direct me in having this working and finally getting through this would be VERY VERY VERY helpful!
Thanks <3
Ana
This problem has been posted here and in a few other forums a few other times.
I've tried editing previous codes and ended up in a blurb of "Man, I really don't know much about coding!"
Here's the deal: I got nearly 1500 .msg files, of which I need their date and subject, to subsequently rename these files based on that info. In order to get each message date and subject I've found this piece of code:
Sub GetMailInfo()
Dim MyOutlook As Outlook.Application
Dim msg As Outlook.MailItem
Dim x As Namespace
Dim Path As String
'Dim FileList As Variant
Set MyOutlook = New Outlook.Application
Set x = MyOutlook.GetNamespace("MAPI")
Path = "C:\Users\TEST 2"
FileList = GetFileList(Path + "*.msg")
Row = 1
While Row <= UBound(FileList) **CURRENT BUG STOPS HERE WITH TYPE 13 MISMATCH ERROR**
Set msg = x.OpenSharedItem(Path + FileList(Row))
Cells(Row + 1, 1) = msg.Subject
Cells(Row + 1, 2) = msg.SenderName
Cells(Row + 1, 3) = msg.SenderEmailAddress
Cells(Row + 1, 4) = msg.CC
Cells(Row + 1, 5) = msg.To
Cells(Row + 1, 6) = msg.SentOn
Cells(Row + 1, 7) = msg.Size
Row = Row + 1
Wend
End Sub
Sub test()
**WHEN RUNNING THIS... I'M GETTING RESULTS SAYING THAT THERE ARE NO FILES MATCHING... WHAT?***
Dim p As String, x As Variant
p = "C:/Users/TEST 2"
x = GetFileList(p + "*.msg")
Select Case IsArray(x)
Case True 'files found
MsgBox UBound(x)
Sheets("Sheet1").Range("A:A").Clear
For i = LBound(x) To UBound(x)
Sheets("Sheet1").Cells(i, 1).Value = x(i)
Next i
Case False 'no files found
MsgBox "No matching files"
End Select
End Sub
Function GetFileList(FileSpec As String) As Variant (another piece of code that was with the first part)
** I'm not sure if the error here is because I have no directory specified for FileSpec **
' Taken from Excel Tips From John Walkenbach: Getting A List Of File Names Using VBA
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False
Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
On Error GoTo NoFilesFound
FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound
' Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function
' Error handler
NoFilesFound:
GetFileList = False
End Function
HELP?
Anything that could direct me in having this working and finally getting through this would be VERY VERY VERY helpful!
Thanks <3
Ana