-
Hi Matt
Found the error. In the spreadsheet, I've added a data entry page with buttons to copy the data onto the code page. This I feel will lead to less problems with messing up the code. To achieve this I named some ranges, and found that one of the named ranges on the data entry page, (not the code page), led to the error message in outlook. Strange as the outlook code doesn't (theoretically) look at this page. However I changed the Range to A1:B2 format and it all works again.
Everything now functions correctly so thanks for your help.
However just one last thing I want to do. I've written the Move section of the code, so after the e-mail is saved on the server it is moved from to a MailFile.pst archive, and I've put a checkbox on the form so this can be removed as an option if the user doesn't want it moved. However I want the value of the checkbox confirmed when one of the 100 buttons is clicked. Is there a way to check the value without putting something in each of the Button_click Subs? (Would that still work as the buttons have been renamed with code?) If I have to, thats fine, I'll just cut & paste it into each Button_click sub, and suck it and see.
Also it moves if the e-mail being closed, which triggers the save form, is from the Inbox but not the Sent box. I attach the Save (including Move) code below. Any idea why?
[VBA] Public StrFile As String
Public StrAllName As String
Public i As Integer
Public vFile As String
Public vSaveFolder As String
Public StrSavePath As String
Option Explicit
Sub SaveSelectedEmails(Optional Path As String)
Dim iItem As Long
Dim StrSubject As String
Dim StrName As String
Dim StrReceived As String
Dim StrFolder As String
Dim StrFolderPath As String
Dim StrSaveFolder As String
Dim Title As String
Dim mItem As MailItem
Dim strMsg As String
Dim Message As Long
Dim vFolder As MAPIFolder 'This will be used to move the e-mails if required after saving
'The next line gives the address of where the e-mail will be saved if required
Set vFolder = Application.Session.Folders("MailFile")
StrSavePath = Path 'Path comes from either the Class Module "clsQuickFormButton" or Module "E_SaveAs"
If Not Right(StrSavePath, 1) = "\" Then 'Ensures there is a final \ at the path end
StrSavePath = StrSavePath & "\"
End If
If Len(Dir(StrSavePath & "*.*")) = 0 Then GoTo Jump1 'This checks if the folder is empty. If so
'it jumps the next error checker
If Len(Dir(StrSavePath)) = 0 Then 'If the "Path" comes from the form then the path may have changed
'or the server connection may be down. This catches the problem.
strMsg = "The File Path does not exist. Check if the" _
& vbCr & "path in the Excel Spreadsheet is correct, " _
& vbCr & " or check the server connection." _
& vbCr & vbCr & " The e-mail has not been saved!"
Message = MsgBox(strMsg, vbOKOnly + vbCritical, "Folder not Found")
GoTo ExitSub:
End
End If
Jump1:
On Error Resume Next
With Outlook.ActiveExplorer.Selection
For iItem = 1 To .Count
StrReceived = Format(.Item(iItem).ReceivedTime, "yymmdd")
StrSubject = .Item(iItem).Subject
If StrSubject = "" Then
strMsg = " The e-mail has no subject" _
& vbCr & " & therefore cannot be saved." _
& vbCr & vbCr & " Add a subject and try again."
MsgBox strMsg
GoTo ExitSub:
End
End If
If Left(StrReceived, 6) = Left(StrSubject, 6) Then GoTo Has_Date
StrName = StripIllegalChar(StrSubject)
StrAllName = StrReceived & " " & StrName & ".msg"
StrFile = StrSavePath & StrAllName
Call Check_Name
StrFile = StrSavePath & StrAllName
StrFile = Left(StrFile, 256) 'THIS NEEDS CHANGING. If the File + Path has more than 256
'characters it'll start by stripping the extension then the (x)
.Item(iItem).SaveAs StrFile, 3 'Unlikely to happen but I suggest putting some $$ in the middle.
GoTo SaveMsg
Has_Date:
StrName = StripIllegalChar(StrSubject)
StrAllName = StrName & ".msg"
StrFile = StrSavePath & " " & StrName & ".msg"
Call Check_Name
StrFile = StrSavePath & StrAllName
StrFile = Left(StrFile, 256) 'THIS NEEDS CHANGING. If the File + Path has more than 256
'characters it'll start by stripping the extension then the (x)
.Item(iItem).SaveAs StrFile, 3
Next
End With
SaveMsg:
With Outlook.ActiveExplorer.Selection 'Added to move the file
If Len(Dir(StrFile)) <> 0 Then 'Checks that the save occured and asks if further save required.
strMsg = "The e-mail has been saved" _
& vbCr & vbCr & "Do you want to save this e-mail to another location?"
Message = MsgBox(strMsg, vbYesNo + vbQuestion + vbDefaultButton2, "E-mail saved")
If Message = vbNo Then Unload Quick_Form
'If chkArchiveBox.Value = False Then GoTo NoMove 'Added to move the file if the box in the Form is ticked
.Item(iItem).Move vFolder 'Added to move the file if the box in the Form is ticked
NoMove: 'Added to move the file if the box in the Form is ticked
'chkArchiveBox.Value = True 'Added to move the file if the box in the Form is ticked
End If
End With 'Added to move the file
If Len(Dir(StrFile)) = 0 Then 'If it didn't save (perhaps the server link was down for a second) it says try again
strMsg = "There has been an error and the e-mail didn't save!" _
& vbCr & vbCr & "Do you want to try again?"
Message = MsgBox(strMsg, vbYesNo + vbCritical, "E-mail not saved!!")
If Message = vbNo Then Unload Quick_Form
End If
ExitSub:
End Sub[/VBA]
Thanks again for your help. Once I've done this bit, I'll tidy it up, put some more error catching in, and update my help file.
Regards
Jeff
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules