Consulting

Page 2 of 3 FirstFirst 1 2 3 LastLast
Results 21 to 40 of 58

Thread: Solved: Changing e-mail "subject" line within a Macro

  1. #21
    VBAX Contributor JeffT's Avatar
    Joined
    Oct 2004
    Location
    Maidenhead, Nr London UK
    Posts
    105
    Location
    Thanks Matt

    I'll try this out tommorow. I've had a go with a hidden sheet and it doesn't work directly. I'm going to try to Unhide / Hide within the code you've given me, Failing that I'll try hiding the columns or locking the cells etc, just working through all the options.

    Jeff

  2. #22
    Knowledge Base Approver
    The King of Overkill!
    VBAX Master
    Joined
    Jul 2004
    Location
    Rochester, NY
    Posts
    1,727
    Location
    I just re-looked at the code and it does just look at the first sheet, regardless of the sheet name. I can't say for sure (without testing, which I can't do at the moment) if it will work with hidden columns (my gut says no, if it didnt work with a hidden sheet). You could make the columns the minimum width without hiding them, and/or simply protecting that worksheet. I don't believe the protection will affect the ADO code.

    I understand you want to go live with this monday, so I'll try and keep an eye out if you need any more help with it
    Matt

  3. #23
    VBAX Contributor JeffT's Avatar
    Joined
    Oct 2004
    Location
    Maidenhead, Nr London UK
    Posts
    105
    Location
    Thanks Matt

    I've got the Save As dialog working (GetOpenFileName) However is there a way to make it a Folder name rather than a file name. At the moment I've added a couple of lines of code so after I select a file it strips out the file name leaving just the path which is what I need. That's fine for now but if the folder is empty then you can't select anything so you have to cancel.

    In Excel I use

    msoFileDialogFolderPicker

    rather than

    msoFileDialogFilePicker.

    but obviously its a LOT more difficult in Outlook!

    Also is there any way to set the initial folder it goes to by default. Once it's been used it remembers the last folder picked, but on inital use each session it goes to 1033 (on my computor at least).

    I've tried adding various paths in this line, which is where I think it should go

    OFN.lpstrInitialDir = IIf(vWindowTitle = "", CurDir, vInitialDir)

    But it either crashes or makes no difference.

    I'm still working on the spreadsheet. It doesn't seem to make any difference whether the sheet is the first one seen in the Book. I've added a second sheet at the start. However it's still called "Sheet1 (Sheet1)" in the editor which is why I believe it still works, it has to be the first sheet made.


    Jeff

  4. #24
    VBAX Contributor JeffT's Avatar
    Joined
    Oct 2004
    Location
    Maidenhead, Nr London UK
    Posts
    105
    Location
    Matt

    Two other items which I've spent hours trying to solve.

    1) On closing an e-mail after the Form has finished I want the possibility of Moving the e-mail to a seperate Folder in Outlook so it moves off the server onto the computer or a separate archive. I thought of putting it in the ClassModule

    [VBA]Private Sub oMailItem_Close(Cancel As Boolean)
    'Event gets triggered if an e-mail is Closed!

    Call Form

    '''''''Put Code here something like '''
    ' oMailItem.move.Folders("MailFile") 'where MailFile is a Folder under personal folders


    Set oMailItem = Nothing
    End Sub[/VBA]

    I know this doesn't work, and have been wondering if it can go here as the e-mail hasn't closed until the end. I'm puting a checkbox in the form so the code will be activated if it is ticked.

    2)Currently the Form is activated when the send button is clicked. this is called from the clsCloseEvent Class Module. I want to put code in here to stop it working if the sent button has been clicked. I then want to activate it only if the e-mail reaches the Sent Items box as send may fail.

  5. #25
    Knowledge Base Approver
    The King of Overkill! VBAX Master
    Joined
    Jul 2004
    Location
    Rochester, NY
    Posts
    1,727
    Location
    Re: Moving the e-mail to a seperate Folder
    Putting this in the class wouldn't work.. though something could be done to do so, you're much better off putting it in your SaveSelectedEmails sub or something. Assuming that "MailFile" is a 'peer' folder of the user's Inbox, add the following to the subroutine:[vba]'put this near the top of saveselectedemails
    Dim vFolder As MAPIFolder
    Set vFolder = Application.Session.GetDefaultFolder(olFolderInbox).Parent.Folders("MailFil e")

    'then put this in your For iItem = ... loop when you want it moved
    .Items(iItem).Move vFolder[/vba]


    2)Currently the Form is activated when the send button is clicked. this is called from the clsCloseEvent Class Module. I want to put code in here to stop it working if the sent button has been clicked. I then want to activate it only if the e-mail reaches the Sent Items box as send may fail.
    What you'd have to do for this is have (along the same lines as your _Send event) a WithEvents variable of type Outlook.Items.. for example:[vba]Dim WithEvents ItemsInSentFolder As Outlook.Items[/vba]
    Then to set that, use:[vba]Set ItemsInSentFolder = Application.Session.GetDefaultFolder(olFolderSentMail)[/vba]
    And to use it:[vba]Private Sub ItemsInSentFolder_ItemAdd(ByVal Item As Object)
    'when a message gets added to the sent folder, this is triggered
    If TypeName(Item) = "MailItem" Then
    'code to run on mail items
    End If
    End Sub[/vba]


    Re: the save-as dialog box, I thought you were giving your users the option to choose the filename too.. if you only want a folder picker, you have a couple options (these are in the knowledgebase here at vbax, I believe). The first uses APIs, like the saveas above. In this case you really only need from the Type statement down, the constants at the top are just for reference:[vba]'Using the windows APIs, this gives you a dialog to select a folder on the computer
    ' There are many different options at the top you can use for the ulFlags property
    ' in the GetDirectory function
    '
    '***** ulFlags options *****
    '** to use multiple flags, either:
    ' -use the OR operator, like BIF_NEWDIALOGSTYLE Or BIF_RETURNONLYFSDIRS
    ' -add the hex values, like &H41 (&H40 + &H1)
    '
    '&H1000
    'Only return computers. If the user selects anything other than a computer, the
    'OK button is grayed.
    Private Const BIF_BROWSEFORCOMPUTER = &H1000

    '&H2000
    'Only return printers. If the user selects anything
    'other than a printer, the OK button is grayed.
    Private Const BIF_BROWSEFORPRINTER = &H2000

    '&H4000
    'The browse dialog will display files as well as folders.
    Private Const BIF_BROWSEINCLUDEFILES = &H4000

    '&H2
    'Do not include network folders below the domain level in the tree view control.
    Private Const BIF_DONTGOBELOWDOMAIN = &H2

    '&H10
    'Include an edit control in the dialog box.
    Private Const BIF_EDITBOX = &H10

    '&H40
    'Use the new user-interface providing the user with a larger resizable dialog box
    'which includes drag and drop, reordering, context menus, new folders, delete, and
    'other context menu commands.
    Private Const BIF_NEWDIALOGSTYLE = &H40

    '&H8
    'Only return file system ancestors. If the user selects anything other than a file
    'system ancestor, the OK button is grayed.
    Private Const BIF_RETURNFSANCESTORS = &H8

    '&H1
    'Only return file system directories. If the user selects folders that are not part
    'of the file system, the OK button is grayed.
    Private Const BIF_RETURNONLYFSDIRS = &H1

    '&H4
    'Include a status area in the dialog box. The callback function can set the status
    'text by sending messages to the dialog box.
    Private Const BIF_STATUSTEXT = &H4

    Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
    End Type
    Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
    (ByVal pidl As Long, ByVal pszPath As String) As Long
    Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
    (lpBrowseInfo As BROWSEINFO) As Long
    Option Explicit
    Public Function GetDirectory(Optional Msg) As String
    Dim bInfo As BROWSEINFO, path As String, r As Long, x As Long, pos As Integer
    bInfo.pidlRoot = 0&
    If IsMissing(Msg) Then
    bInfo.lpszTitle = "Select a folder."
    Else
    bInfo.lpszTitle = Msg
    End If
    bInfo.ulFlags = &H51 'use hex or constants
    x = SHBrowseForFolder(bInfo)
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then pos = InStr(path, CHR$(0)): GetDirectory = Left$(path, pos - 1)
    End Function
    Sub ExampleSubForGetDirectory()
    Debug.Print GetDirectory("hi")
    End Sub[/vba]

    That gives you a ton of flexibility over what you can do with it.. however if you simply want a folder picker, check out the BrowseForFolder method of the shell object:[vba] Dim ShellApp As Object, shFolder As Object, shFolderName As String
    Set sa = CreateObject("Shell.Application")
    Set shFolder = sa.BrowseForFolder(0, "Select Folder to Save Output File", 0, "")
    If shFolder Is Nothing Then Exit Sub 'cancel
    shFolderName = shFolder.Items.Item.Path & "\"
    MsgBox shFolderName
    Set ShellApp = Nothing
    Set shFolder = Nothing[/vba]

    Sorry about the delay in getting back to you, went to canada over the weekend with some friends and then last night went to my father's house.
    Matt

  6. #26
    VBAX Contributor JeffT's Avatar
    Joined
    Oct 2004
    Location
    Maidenhead, Nr London UK
    Posts
    105
    Location
    Thanks Matt.
    No need to apologise I'm just grateful for the time you've spent on my problems. I'll have a try with all the code above.

    I'm off on holiday Friday night and my wife has said I can't take my laptop So I'll be out of touch for a couple of weeks. Hopefully I won't have to bother you much more if at all. I'll let you know how it all goes though.

    Jeff

  7. #27
    Knowledge Base Approver
    The King of Overkill! VBAX Master
    Joined
    Jul 2004
    Location
    Rochester, NY
    Posts
    1,727
    Location
    I'm not going anywhere, so whenever you get to it is fine with me
    Matt

  8. #28
    VBAX Contributor JeffT's Avatar
    Joined
    Oct 2004
    Location
    Maidenhead, Nr London UK
    Posts
    105
    Location
    Back Again!!

    I've been running the Folder Picker code

    [VBA]Sub GetOpenFolderName() 'This doesn't work if the folder is empty

    Dim ShellApp As Object, shFolder As Object, vFile As String 'shFolderName As String 'Commented out by JT and vFile added in its place
    Dim sa As Object
    Set sa = CreateObject("Shell.Application")
    Set shFolder = sa.BrowseForFolder(0, "Select Folder to Save E-mail to", 0, "")
    If shFolder Is Nothing Then Exit Sub 'cancel
    vFile = shFolder.Items.Item.Path & "\"
    If vFile <> "" Then MsgBox vFile 'Temporary line to check the path name before activating
    Call SaveSelectedEmails(vFile) 'Added by JT

    Set ShellApp = Nothing
    Set shFolder = Nothing
    End Sub[/VBA]

    This works great except if the destination folder is empty. Any idea why that might be? It acts like the original code for selecting a file name in that if the folder was empty it you couldn't select a file. This is where the code goes next

    [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 i As Long
    'Dim j As Long
    'Dim n As Long
    Dim iItem As Long
    Dim StrSubject As String
    Dim StrName As String
    Dim StrReceived As String
    'Dim StrSavePath 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


    StrSavePath = Path 'Path comes from either the Class Module "clsQuickFormButton" or Module "E_SaveAs"

    If Len(Dir(StrSavePath)) = 0 Then '''' IT FAILS HERE '''' '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

    '''''''''' Lots more code''''''''''''''
    [/VBA]

    Don't worry if you're busy just of interest unless it's easily solvable. It'll rarely happen & I can put a message on the "Find Folder" dialog box.

    Jeff

  9. #29
    Knowledge Base Approver
    The King of Overkill! VBAX Master
    Joined
    Jul 2004
    Location
    Rochester, NY
    Posts
    1,727
    Location
    Interesting stuff! I always use that browse for folder method while appending files, and though I know it says "shFolder.Items.Item.Path" which gets an item in the folder and returns it's path, I didn't put 2 and 2 together about your problem with the GetSaveAsFilename method. Derrrrrrr.... anyways.

    After playing around with the Folder object a little bit, I think I have a good working solution for you (and for my bag of tricks!):[vba]Sub GetOpenFolderName()
    Dim ShellApp As Object, shFolder As Object, vPath As String
    Set ShellApp = CreateObject("Shell.Application")
    Set shFolder = ShellApp.BrowseForFolder(0, "Select Folder to Save E-mail to", 1, "")
    If shFolder Is Nothing Then Exit Sub 'cancel

    Do Until shFolder.Title Like "*(?"
    vPath = shFolder.Title & "\" & vPath
    Set shFolder = shFolder.ParentFolder
    Loop
    vPath = Mid(shFolder.Title, InStr(1, shFolder.Title, "(") + 1, 2) & "\" & vPath

    If Len(vPath) > 0 Then MsgBox vPath 'Temporary line to check the path name before activating
    Call SaveSelectedEmails(vPath) 'Added by JT
    Set ShellApp = Nothing
    Set shFolder = Nothing
    End Sub[/vba] Give it a whirl, should do what we need!

    EDIT: Won't work on the "Control Panel" folder, which is in the popup box. Playing around with that now to see if I can prevent it

    EDIT AGAIN: Fixed it in the code above
    Matt

  10. #30
    Knowledge Base Approver
    The King of Overkill! VBAX Master
    Joined
    Jul 2004
    Location
    Rochester, NY
    Posts
    1,727
    Location
    As an addition, this is in regards to the "" at the end of BrowseForFolder:
    Quote Originally Posted by http://msdn2.microsoft.com/en-us/library/ms630408.aspx
    Optional. The root folder to use in the dialog box. The user cannot browse higher in the tree than this folder. If this value is not specified, the root folder used in the dialog box is the desktop. This value can be a string that specifies the path of the folder or one of the ShellSpecialFolderConstants values. Note that the constant names found in ShellSpecialFolderConstants are available in Microsoft Visual Basic, but not in Visual Basic Scripting Edition (VBScript) or Microsoft JScript. In those cases, the numeric values must be used in their place.
    The 1 in the same BrowseForFolder call are the flags for it (the same BIF_ constants above), I changed the above to be 1 as that prevents the My Computer and Control Panel from being selected.
    You may want to make it 17, which also adds an 'edit box' so the user can manually type in "N:\contracts\". Note that shFolder will be Nothing if an invalid folder is typed, so maybe keeping it as 1 is better.
    Matt

  11. #31
    VBAX Contributor JeffT's Avatar
    Joined
    Oct 2004
    Location
    Maidenhead, Nr London UK
    Posts
    105
    Location
    Hi Matt

    I'm back. First of all congratulations on your well deserved elevation within the community.

    Everything is working OK but I've a few things I want to do and can't figure them out so perhaps you could help again.

    1) the Form was always called as soon as an e-mail was closed. This is normally fine but it activated when the send button was clicked (because the e-mail closed) but before the e-mail was sent. this would mean that it might be saved on the server even if the send failed. I've added some code to stop this, but want to activate the form when the e-mail enters the Sent folder. Is there anything like

    [VBA]Private Sub Application_ItemSend[/VBA]

    but with ItemSent?

    All I want to do is for the code to run when an e-mail arrives in the Sent Folder, open the last e-mail to arrive and close it again. This will open the form again. I think something using olFolderSentMail might be possible but have reached a dead end.

    2) Is there a way with your fantastic spreadsheet code to have an additional line at the bottom of the spreadsheet which can be used as part of the subject line. This way people could change the subject from the spreadsheet. I currently set it in the code.

    People are impressed with how it works but I'm still fixing bugs at the moment.

    Regards

    Jeff

  12. #32
    Knowledge Base Approver
    The King of Overkill! VBAX Master
    Joined
    Jul 2004
    Location
    Rochester, NY
    Posts
    1,727
    Location
    Hi Jeff,

    Regarding _ItemSend, there is no equivalent _ItemSent folder. Luckily we can still use events to capture such things. I touched upon it in post #25 above, but only briefly. Consider the following code (goes into the ThisOutlookSession object):[vba]Option Explicit
    Dim WithEvents ItemsInSentFolder As Outlook.Items
    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    If ItemsInSentFolder Is Nothing Then Call SetSentItemsFolderEvents
    End Sub
    Private Sub Application_Quit()
    Set ItemsInSentFolder = Nothing
    End Sub
    Private Sub Application_Startup()
    SetSentItemsFolderEvents
    End Sub
    Private Function SetSentItemsFolderEvents()
    Set ItemsInSentFolder = Application.Session.GetDefaultFolder(olFolderSentMail)
    End Function
    Private Sub ItemsInSentFolder_ItemAdd(ByVal Item As Object)
    'when a message gets added to the sent folder, this is triggered
    'the variable "Item" refers to the item just added to the Sent Folder
    If TypeName(Item) = "MailItem" Then
    'code to call your form
    End If
    End Sub[/vba]

    The last sub there, _ItemAdd, will only get called when something is added to the Sent folder. Note this occurs even if you manually click/drag something into it; if this is an issue we could probably create a boolean variable set from _ItemSend (something along the lines of "ItemBeingSent = True", and then set back to false in the _ItemAdd event), but it seems like such a low possibility that I just wouldn't worry about it (could contradict itself, losing functionality, though thats a low possibility too).

    Regarding the subject line in the spreadsheet, that would be possible, though I'd advise against putting it at the bottom of the data and instead suggest putting it to the right of the data (Maybe E2 or F2 -- don't use row 1). Then in the Form's code there is a line that says "xArr = GetQuickFormData". xArr is then an array containing data, and you use columns 0-3 for the form data. If you put the subject line in column F2 for example, xArr(5, 0) would refer to the data in that cell, and you could set the subject line accordingly, even putting something in like[vba]If Len(Trim(xArr(5, 0))) = 0 Then
    YourSubjectVariable = "Default subject line"
    Else
    YourSubjectVariable = xArr(5, 0)
    End If[/vba]In case the user doesnt set it in the spreadsheet (or deletes it or something)
    Matt

  13. #33
    VBAX Contributor JeffT's Avatar
    Joined
    Oct 2004
    Location
    Maidenhead, Nr London UK
    Posts
    105
    Location

    Smile

    Thanks Matt

    I've a problem with the Private function Code in that it fails on startup. If I comment it out Outlook opens the Macros. If I then uncomment it, I get the same error message and the code stops the send untill I clear the error.

    [VBA]Private Function SetSentItemsFolderEvents() 'This is part of the "OnSent" Code

    'The code fails on the line below on startup. The Error is
    ' Run-time error '13':
    ' Type mismatch

    Set ItemsInSentFolder = Application.Session.GetDefaultFolder(olFolderSentMail)

    End Function
    [/VBA]


    I had a lot of the subs you listed already running other code so pasted the relevant pieces of code into the same subs. I presume this was correct eg you can't have more than one version of :-

    [VBA]Private Sub Application_Startup() [/VBA]

    for instance running at the same time? I enclose a copy of ThisOutlookSession (for which I apologise in advance for the mess in the code) in case you want to look at it.

    With regard to the subject line code. I've got it so that it picks up the value of the E2 cell using xArr(4,0) but haven't yet got this into the e-mail. I think I need to write a separate Sub as the existing one only fires when the form opens. Still I'll try that tommorow. I hadn't realised that the excel spreadsheet can be open and it still picks up the button values (even if the values are added and not even saved). This means you can almost work on the fly with it. Amazing.

    Lastly the
    [VBA]If Len(Trim(xArr(4, 0))) = 0 Then

    'Didn't work even when it did = 0 it jumped to the Else statement. 'Strange! I got over it by using:-

    If IsNull(xArr(4, 0)) Then
    Subject = "E-mail Subject "
    Else
    Subject = xArr(4, 0)
    End If[/VBA]


    Which in my own simple way has pleased me.

    Thanks again
    (this may duplicate as I lost it all trying to add the smily , but the attachment was still there when I finished retyping)

    Jeff

  14. #34
    Knowledge Base Approver
    The King of Overkill! VBAX Master
    Joined
    Jul 2004
    Location
    Rochester, NY
    Posts
    1,727
    Location
    Oops! Forgot the most important keyword...
    Since "ItemsInSentFolder" is an Outlook.Items object, add .Items after the GetDefaultFolder:[vba]Set ItemsInSentFolder = Application.Session.GetDefaultFolder(olFolderSentMail).Items[/vba]Yeah, doesn't seem to work when you leave out the most important part of it
    Matt

  15. #35
    VBAX Contributor JeffT's Avatar
    Joined
    Oct 2004
    Location
    Maidenhead, Nr London UK
    Posts
    105
    Location
    Thanks Matt

    I think that works now, unfortunately though the code loads and runs, I end up with a "Runtime error 9 subscript out of Range" !!

    It happens even if I comment the changed line out so I don't think its anything to do with that. I've probably just deleted something so I'll have to track it down.

    Thanks again

    Jeff

  16. #36
    Knowledge Base Approver
    The King of Overkill! VBAX Master
    Joined
    Jul 2004
    Location
    Rochester, NY
    Posts
    1,727
    Location
    What line is generating that error? Usually that error means you are requesting a non-existing member of a collection, like requesting... [vba]ActiveExplorer.Selection.Item(3)[/vba]...if there are only 2 items

    Chances are it was something you changed trying to fix my mistake, hopefully we can get it back to normal
    Matt

  17. #37
    VBAX Contributor JeffT's Avatar
    Joined
    Oct 2004
    Location
    Maidenhead, Nr London UK
    Posts
    105
    Location
    Hi Matt

    It fails here :-

    [VBA]Private Sub GetSubject() 'This gets the subject line from the excel spreadsheet which
    'has to be located in the path shown at the top of the module.
    Dim xArr() As Variant
    xArr = GetSubjectData 'Get subject data is the function below

    If IsNull(xArr(4, 0)) Then ' CODE FAILS ON THIS LINE

    Subject = "No subject in excel file " 'PUT ANY DEFAULT SUBJECT HERE
    Else
    Subject = xArr(4, 0)
    End If
    End Sub
    [/VBA]

    if I try to open a new e-mail with my "MailFile New" Button which automatically puts the reverse date and subject in.

    It also fails here :-

    [VBA] Sub Form() 'GetQuick_Form()
    'This opens the Quick_Form

    Load Quick_Form ' IT FAILS HERE
    Quick_Form.Show

    End Sub
    [/VBA]

    when I close an open e-mail. This calls the form with the 100 shortcut buttons.

    What I'm currently doing is copying all the separate modules into word. then I'll export them all to a new folder, import the last lot of working code and slowly add the revisions to see when it stops working. Unfortunately my last "backup" was 070724 (in reverse notation) I started one 070727 but only put ThisOutlookSession in it

    I use word so I can cut and paste the code.

    I've also just messed up my VBE window so am going to trawl the forum to see if it says how to get the windows back. I usually have the code on the Right, with the Project explorer & Properties on the left. I dragged or clicked on something and its all over the place now, & Help is no Help at all.

    Jeff

  18. #38
    VBAX Contributor JeffT's Avatar
    Joined
    Oct 2004
    Location
    Maidenhead, Nr London UK
    Posts
    105
    Location
    Got my windows sorted out again and everything exported / old imported. Tommorow I'll start looking for the error.

    Thanks

  19. #39
    VBAX Contributor JeffT's Avatar
    Joined
    Oct 2004
    Location
    Maidenhead, Nr London UK
    Posts
    105
    Location
    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

  20. #40
    VBAX Contributor JeffT's Avatar
    Joined
    Oct 2004
    Location
    Maidenhead, Nr London UK
    Posts
    105
    Location
    Hi Matt in case you're still watching this

    I've sorted the checkbox problem, I'll just add the Call code to each button_click.

    Just got to make the move of the e-mail in the sent file work. I think I've just got to follow the code as it goes down that particular route. It's getting quite complex now.

    Hopefully next post will be the finished work.

    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
  •