C
Chris
I need help with ordering an set of variables (strSend,strSubj,StrTime) and
keeping them in that order. I use a userform to allow the user to select one
of the ten formats and assign the order to the variable FileNameFormat
(FileNameFormat = strTime & "_" & strSend & "_" & strSubj). The problem is
that the FileNameFormat takes the values of the variables once and will not
update with the new data as the loop is run (NewFileName = FileNameFormat &
".msg"). Is there a way to store the order of variables in another variable
to be able to assign the values of those stored variables as they change?
-----Variable Declarations-----
Global FileNameFormat As Variant
Global strSubj, strTime, strSend, mailClassCheck, EmailPath As String
Global RunOnce As Boolean
-----Module Code-----
Public Sub ExportSAR()
Dim TheEmail As Object
Dim ReportEmail As ReportItem
Dim eItem As Outlook.Items
Dim EmailNS As NameSpace
Dim fldrCount, EmailPath2, NbrItem, myfolder
Dim NewFileName, ReportHeader As String
Dim Cats
Dim CheckErr, Exists As Boolean
CheckErr = False
RunOnce = False
Set EmailNS = Application.GetNamespace("MAPI")
Set myfolder = Application.ActiveExplorer.CurrentFolder
NbrItem = myfolder.Items.Count
On Error GoTo Error_Handler
EmailPath = BrowseForFolderShell
'FileName.Show
'MsgBox FileNameFormat
'MsgBox EmailPath, vbOKCancel
'EmailPath = InputBox("Enter the save folder location:", "Email Save
Path", CurDir)
For i = 1 To NbrItem
Set TheEmail = Application.ActiveExplorer.CurrentFolder.Items.Item(i)
'MsgBox Len(TheEmail.SenderName) & Chr$(13) & Len(TheEmail.Subject) &
Chr$(13) & Len(TheEmail.ReceivedTime)
'MsgBox TheEmail.SenderName & Chr$(13) & TheEmail.Subject & Chr$(13) &
TheEmail.ReceivedTime
TheEmail.Categories = TheEmail.Categories & ";" & "Red Category"
mailClassCheck = TheEmail.MessageClass
If Left(mailClassCheck, 6) = "REPORT" Or Left(mailClassCheck, 6) =
"Report" Then
Set ReportEmail =
Application.ActiveExplorer.CurrentFolder.Items.Item(i)
If ReportEmail.Subject = "" Then strSubj = "no subject"
If Right(ReportEmail.MessageClass, 2) = "DR" Then ReportHeader =
"DeliveryReport" Else ReportHeader = "Read Receipt"
strSubj = Replace(ReportEmail.Subject, "/", "-")
strSubj = Replace(strSubj, "\", "-")
strSubj = Replace(strSubj, ":", "--")
strSubj = Replace(strSubj, "?", sReplace)
strSubj = Replace(strSubj, "*", sReplace)
strSubj = Replace(strSubj, Chr$(34), sReplace)
'strSubj = Replace(strSubj, Chr$(9), sReplace)
strSubj = Replace(strSubj, "<", sReplace)
strSubj = Replace(strSubj, ">", sReplace)
strSubj = Replace(strSubj, "|", sReplace)
strTime = Replace(ReportEmail.CreationTime, "/", "-")
strTime = Replace(strTime, "\", "-")
strTime = Replace(strTime, ":", ".")
strTime = Replace(strTime, "?", sReplace)
strTime = Replace(strTime, "*", sReplace)
strTime = Replace(strTime, Chr$(34), sReplace)
strTime = Replace(strTime, "<", sReplace)
strTime = Replace(strTime, ">", sReplace)
strTime = Replace(strTime, "|", sReplace)
NewFileName = ReportHeader & "_" & strSubj & strTime & ".msg"
MsgBox FileNameFormat
If NewFileName <> "" Then
ReportEmail.SaveAs EmailPath & NewFileName, olMSG
Else
MsgBox "No file name was entered. Operation aborted.", 64,
"Cancel Operation"
Exit Sub
End If
GoTo Step1
End If
If TheEmail.Subject = "" Then strSubj = "no subject"
strSend = Replace(TheEmail.SenderName, "/", "-")
strSend = Replace(strSend, "\", "-")
strSend = Replace(strSend, ":", "--")
strSend = Replace(strSend, "?", sReplace)
strSend = Replace(strSend, "*", sReplace)
strSend = Replace(strSend, Chr$(34), sReplace)
strSend = Replace(strSend, "<", sReplace)
strSend = Replace(strSend, ">", sReplace)
strSend = Replace(strSend, "|", sReplace)
strSubj = Replace(TheEmail.Subject, "/", "-")
strSubj = Replace(strSubj, "\", "-")
strSubj = Replace(strSubj, ":", "--")
strSubj = Replace(strSubj, "?", sReplace)
strSubj = Replace(strSubj, "*", sReplace)
strSubj = Replace(strSubj, Chr$(34), sReplace)
'strSubj = Replace(strSubj, Chr$(9), sReplace)
strSubj = Replace(strSubj, "<", sReplace)
strSubj = Replace(strSubj, ">", sReplace)
strSubj = Replace(strSubj, "|", sReplace)
strSubj = Replace(strSubj, "{", sReplace)
strSubj = Replace(strSubj, "}", sReplace)
strSubj = Replace(strSubj, " ", sReplace)
strTime = Replace(TheEmail.ReceivedTime, "/", "-")
strTime = Replace(strTime, "\", "-")
strTime = Replace(strTime, ":", ".")
strTime = Replace(strTime, "?", sReplace)
strTime = Replace(strTime, "*", sReplace)
strTime = Replace(strTime, Chr$(34), sReplace)
strTime = Replace(strTime, "<", sReplace)
strTime = Replace(strTime, ">", sReplace)
strTime = Replace(strTime, "|", sReplace)
'NewFileName = strSend & "_" & strTime & "_" & strSubj & ".msg"
If RunOnce = False Then
FileName.Show
MsgBox FileNameFormat
RunOnce = True
End If
NewFileName = FileNameFormat & ".msg"
If NewFileName <> "" Then
If Len(NewFileName) > 160 Then
TooLong:
NewFileName = InputBox("Please Enter a New File Name that is
shorter than 161 characters." & Chr$(13) & "Current file name is " &
Len(NewFileName) & "characters.", _
"File Name Too Long", NewFileName)
If Len(NewFileName) > 160 Then
MsgBox "File name is still too long." & Chr$(13) & "Current file
name is " & Len(NewFileName) & "characters.", vbOKOnly, "File Name is Too
Long"
GoTo TooLong
Else
TheEmail.SaveAs EmailPath & NewFileName, olMSG
End If
Else
TheEmail.SaveAs EmailPath & NewFileName, olMSG
End If
Else
MsgBox "No file name was entered. Operation aborted.", 64,
"Cancel Operation"
Exit Sub
End If
Step1:
strSubj = ""
strTime = ""
Next i
GoTo Done
Error_Handler:
If TheEmail Is Nothing Then
MsgBox Err.Number & ":" & Err.Description
TheEmail.Categories = TheEmail.Categories & ";" & "Not Copied"
Else
MsgBox TheEmail.MessageClass & Chr$(13) & Len(NewFileName) & Chr$(13) &
Chr$(13) & strSend & Chr$(13) & strTime & Chr$(13) & TheEmail.Subject &
Chr$(13) & strSubj & Chr$(13) & Err.Number & ": " & Err.Description
TheEmail.Categories = TheEmail.Categories & ";" & "Not Copied"
TheEmail.Save
End If
Resume Next
Done:
End Sub
-----UserForm Code-----
Private Sub Submit_Click()
Select Case FileFormat
Case DateSendSubj
FileNameFormat = strTime & "_" & strSend & "_" & strSubj
Case DateSubj
FileNameFormat = strTime & "_" & strSubj
Case DateSubjSend
FileNameFormat = strTime & "_" & strSubj & "_" & strSend
Case SendDateSubj
FileNameFormat = strSend & "_" & strTime & "_" & strSubj
Case SendSubj
FileNameFormat = strSend & "_" & strSubj
Case SendSubjDate
FileNameFormat = strSend & "_" & strSubj & "_" & strTime
Case SubjDate
FileNameFormat = strSubj & "_" & strTime
Case SubjDateSend
FileNameFormat = strSubj & "_" & strTime & "_" & strSend
Case SubjSend
FileNameFormat = strSubj & "_" & strSend
Case SubjSendDate
FileNameFormat = strSubj & "_" & strSend & "_" & strTime
End Select
Me.Hide
End Sub
keeping them in that order. I use a userform to allow the user to select one
of the ten formats and assign the order to the variable FileNameFormat
(FileNameFormat = strTime & "_" & strSend & "_" & strSubj). The problem is
that the FileNameFormat takes the values of the variables once and will not
update with the new data as the loop is run (NewFileName = FileNameFormat &
".msg"). Is there a way to store the order of variables in another variable
to be able to assign the values of those stored variables as they change?
-----Variable Declarations-----
Global FileNameFormat As Variant
Global strSubj, strTime, strSend, mailClassCheck, EmailPath As String
Global RunOnce As Boolean
-----Module Code-----
Public Sub ExportSAR()
Dim TheEmail As Object
Dim ReportEmail As ReportItem
Dim eItem As Outlook.Items
Dim EmailNS As NameSpace
Dim fldrCount, EmailPath2, NbrItem, myfolder
Dim NewFileName, ReportHeader As String
Dim Cats
Dim CheckErr, Exists As Boolean
CheckErr = False
RunOnce = False
Set EmailNS = Application.GetNamespace("MAPI")
Set myfolder = Application.ActiveExplorer.CurrentFolder
NbrItem = myfolder.Items.Count
On Error GoTo Error_Handler
EmailPath = BrowseForFolderShell
'FileName.Show
'MsgBox FileNameFormat
'MsgBox EmailPath, vbOKCancel
'EmailPath = InputBox("Enter the save folder location:", "Email Save
Path", CurDir)
For i = 1 To NbrItem
Set TheEmail = Application.ActiveExplorer.CurrentFolder.Items.Item(i)
'MsgBox Len(TheEmail.SenderName) & Chr$(13) & Len(TheEmail.Subject) &
Chr$(13) & Len(TheEmail.ReceivedTime)
'MsgBox TheEmail.SenderName & Chr$(13) & TheEmail.Subject & Chr$(13) &
TheEmail.ReceivedTime
TheEmail.Categories = TheEmail.Categories & ";" & "Red Category"
mailClassCheck = TheEmail.MessageClass
If Left(mailClassCheck, 6) = "REPORT" Or Left(mailClassCheck, 6) =
"Report" Then
Set ReportEmail =
Application.ActiveExplorer.CurrentFolder.Items.Item(i)
If ReportEmail.Subject = "" Then strSubj = "no subject"
If Right(ReportEmail.MessageClass, 2) = "DR" Then ReportHeader =
"DeliveryReport" Else ReportHeader = "Read Receipt"
strSubj = Replace(ReportEmail.Subject, "/", "-")
strSubj = Replace(strSubj, "\", "-")
strSubj = Replace(strSubj, ":", "--")
strSubj = Replace(strSubj, "?", sReplace)
strSubj = Replace(strSubj, "*", sReplace)
strSubj = Replace(strSubj, Chr$(34), sReplace)
'strSubj = Replace(strSubj, Chr$(9), sReplace)
strSubj = Replace(strSubj, "<", sReplace)
strSubj = Replace(strSubj, ">", sReplace)
strSubj = Replace(strSubj, "|", sReplace)
strTime = Replace(ReportEmail.CreationTime, "/", "-")
strTime = Replace(strTime, "\", "-")
strTime = Replace(strTime, ":", ".")
strTime = Replace(strTime, "?", sReplace)
strTime = Replace(strTime, "*", sReplace)
strTime = Replace(strTime, Chr$(34), sReplace)
strTime = Replace(strTime, "<", sReplace)
strTime = Replace(strTime, ">", sReplace)
strTime = Replace(strTime, "|", sReplace)
NewFileName = ReportHeader & "_" & strSubj & strTime & ".msg"
MsgBox FileNameFormat
If NewFileName <> "" Then
ReportEmail.SaveAs EmailPath & NewFileName, olMSG
Else
MsgBox "No file name was entered. Operation aborted.", 64,
"Cancel Operation"
Exit Sub
End If
GoTo Step1
End If
If TheEmail.Subject = "" Then strSubj = "no subject"
strSend = Replace(TheEmail.SenderName, "/", "-")
strSend = Replace(strSend, "\", "-")
strSend = Replace(strSend, ":", "--")
strSend = Replace(strSend, "?", sReplace)
strSend = Replace(strSend, "*", sReplace)
strSend = Replace(strSend, Chr$(34), sReplace)
strSend = Replace(strSend, "<", sReplace)
strSend = Replace(strSend, ">", sReplace)
strSend = Replace(strSend, "|", sReplace)
strSubj = Replace(TheEmail.Subject, "/", "-")
strSubj = Replace(strSubj, "\", "-")
strSubj = Replace(strSubj, ":", "--")
strSubj = Replace(strSubj, "?", sReplace)
strSubj = Replace(strSubj, "*", sReplace)
strSubj = Replace(strSubj, Chr$(34), sReplace)
'strSubj = Replace(strSubj, Chr$(9), sReplace)
strSubj = Replace(strSubj, "<", sReplace)
strSubj = Replace(strSubj, ">", sReplace)
strSubj = Replace(strSubj, "|", sReplace)
strSubj = Replace(strSubj, "{", sReplace)
strSubj = Replace(strSubj, "}", sReplace)
strSubj = Replace(strSubj, " ", sReplace)
strTime = Replace(TheEmail.ReceivedTime, "/", "-")
strTime = Replace(strTime, "\", "-")
strTime = Replace(strTime, ":", ".")
strTime = Replace(strTime, "?", sReplace)
strTime = Replace(strTime, "*", sReplace)
strTime = Replace(strTime, Chr$(34), sReplace)
strTime = Replace(strTime, "<", sReplace)
strTime = Replace(strTime, ">", sReplace)
strTime = Replace(strTime, "|", sReplace)
'NewFileName = strSend & "_" & strTime & "_" & strSubj & ".msg"
If RunOnce = False Then
FileName.Show
MsgBox FileNameFormat
RunOnce = True
End If
NewFileName = FileNameFormat & ".msg"
If NewFileName <> "" Then
If Len(NewFileName) > 160 Then
TooLong:
NewFileName = InputBox("Please Enter a New File Name that is
shorter than 161 characters." & Chr$(13) & "Current file name is " &
Len(NewFileName) & "characters.", _
"File Name Too Long", NewFileName)
If Len(NewFileName) > 160 Then
MsgBox "File name is still too long." & Chr$(13) & "Current file
name is " & Len(NewFileName) & "characters.", vbOKOnly, "File Name is Too
Long"
GoTo TooLong
Else
TheEmail.SaveAs EmailPath & NewFileName, olMSG
End If
Else
TheEmail.SaveAs EmailPath & NewFileName, olMSG
End If
Else
MsgBox "No file name was entered. Operation aborted.", 64,
"Cancel Operation"
Exit Sub
End If
Step1:
strSubj = ""
strTime = ""
Next i
GoTo Done
Error_Handler:
If TheEmail Is Nothing Then
MsgBox Err.Number & ":" & Err.Description
TheEmail.Categories = TheEmail.Categories & ";" & "Not Copied"
Else
MsgBox TheEmail.MessageClass & Chr$(13) & Len(NewFileName) & Chr$(13) &
Chr$(13) & strSend & Chr$(13) & strTime & Chr$(13) & TheEmail.Subject &
Chr$(13) & strSubj & Chr$(13) & Err.Number & ": " & Err.Description
TheEmail.Categories = TheEmail.Categories & ";" & "Not Copied"
TheEmail.Save
End If
Resume Next
Done:
End Sub
-----UserForm Code-----
Private Sub Submit_Click()
Select Case FileFormat
Case DateSendSubj
FileNameFormat = strTime & "_" & strSend & "_" & strSubj
Case DateSubj
FileNameFormat = strTime & "_" & strSubj
Case DateSubjSend
FileNameFormat = strTime & "_" & strSubj & "_" & strSend
Case SendDateSubj
FileNameFormat = strSend & "_" & strTime & "_" & strSubj
Case SendSubj
FileNameFormat = strSend & "_" & strSubj
Case SendSubjDate
FileNameFormat = strSend & "_" & strSubj & "_" & strTime
Case SubjDate
FileNameFormat = strSubj & "_" & strTime
Case SubjDateSend
FileNameFormat = strSubj & "_" & strTime & "_" & strSend
Case SubjSend
FileNameFormat = strSubj & "_" & strSend
Case SubjSendDate
FileNameFormat = strSubj & "_" & strSend & "_" & strTime
End Select
Me.Hide
End Sub