amcbarnes
01-27-2007, 09:50 PM
I download "tickets" everyday that are email attached excel files and I am using code inside excel to save these files to a folder for use on the job. I am currently using this code:
Public Sub findfsr()
Dim ns As Outlook.Namespace
Dim Inbox As Outlook.MAPIFolder
Dim SubFolder As Outlook.MAPIFolder
Dim Item As Object
Dim Atmt As Outlook.Attachment
Dim FileName As String
Dim i As Integer
Set ns = Outlook.GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders("Clearview")
i = 0
If SubFolder.Items.Count = 0 Then
MsgBox "There are no FSR's in the Clearview Folder", vbInformation, _
"Nothing Found"
Exit Sub
End If
For Each Item In SubFolder.Items
For Each Atmt In Item.Attachments
FileName = "C:\FSR\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
Next Atmt
Next Item
If i > 0 Then
MsgBox "Found " & i & " FSR's.", vbInformation, "Finished!"
Else
MsgBox "No FSR's Found.", vbInformation, _
"Finished!"
End If
findfsr_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Set app01 = Nothing
Exit Sub
findfsr_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: findfsr" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume findfsr_exit
End Sub
The problem is these filenames are confusing and there are many files that I have difficulty sorting through manually. I want to rename these with names that are easy to recognize and are job specific. an easy name for each file is contained in a specific cell already in each file, but I don't know how to get that cell reference to be used as the rename. any help would be greatly appreciated.
Public Sub findfsr()
Dim ns As Outlook.Namespace
Dim Inbox As Outlook.MAPIFolder
Dim SubFolder As Outlook.MAPIFolder
Dim Item As Object
Dim Atmt As Outlook.Attachment
Dim FileName As String
Dim i As Integer
Set ns = Outlook.GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders("Clearview")
i = 0
If SubFolder.Items.Count = 0 Then
MsgBox "There are no FSR's in the Clearview Folder", vbInformation, _
"Nothing Found"
Exit Sub
End If
For Each Item In SubFolder.Items
For Each Atmt In Item.Attachments
FileName = "C:\FSR\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
Next Atmt
Next Item
If i > 0 Then
MsgBox "Found " & i & " FSR's.", vbInformation, "Finished!"
Else
MsgBox "No FSR's Found.", vbInformation, _
"Finished!"
End If
findfsr_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Set app01 = Nothing
Exit Sub
findfsr_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: findfsr" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume findfsr_exit
End Sub
The problem is these filenames are confusing and there are many files that I have difficulty sorting through manually. I want to rename these with names that are easy to recognize and are job specific. an easy name for each file is contained in a specific cell already in each file, but I don't know how to get that cell reference to be used as the rename. any help would be greatly appreciated.