UserForm and ordering variables

  • Thread starter Thread starter Chris
  • Start date Start date
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
 
Sorry, but I really can't see the problem here, because I don't know what the
user interaction might be in your scenario. Maybe you should step away from
the keyboard and sketch out a flow chart that includes those interaction
points. In other words, how does "the new data" you described in your
original post get injected into the process? Once you can visualize that, I
suspect you'll see the solution, too -- or at least be able to communicate
more information to us.
--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54
 
Sue,

I figured it out. I set a flag to the variable FileNameFormat on the
userform and then use Select Case FileNameFormat back in the module to set
the filename.

Chris
 
Back
Top