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

[JeffT]

Hi

I've written (using others code as a basis) a macro which on clicking a button on the tool bar opens a new e-mail with the reverse date in the subject line, eg 070530 would be todays, (it's just what we do). I can also add for instance the current contract name I'm working on as well. Then I only have to type a couple of extra descriptive words.

However others in the company have seen this, and want to do the same. The problem is they aren't capable of editing macros within VBA and so I want to know if it's possible to use a dialog box, in which they can type their subject, and then have this entered into or called from the macro.

I asked something similar earlier and had no reply. If the answer is no I'd like to know that as well.

I'm currently playing with the idea of storing the words in a spreadsheet (Which they'd be happy editing) and calling this, copying the cell value and pasting this into the subject line. Not sure if this is possible either. However using code I found here it's possible to paste words into the spreadsheet from the macro, so I'd have thought it could work the other way. However hopefully there's a more elegant way.

Hopefully someone will let me know one way or another.

Regards

Jeff T

[mvidas]

Jeff,

Are you running this from outlook, or from Excel? I'm assuming outlook, so I'll show you how to do it from there, but I can modify it to call it from excel too if you'd like:Sub JeffT()
Dim TempStr As String, iMsg As MailItem
TempStr = InputBox("Please enter subject for new mail", "Enter subject line", _
Format(Date, "yymmdd "))
If Len(TempStr) = 0 Then Exit Sub
Set iMsg = Application.CreateItem(0) '0=olMailItem
iMsg.Subject = TempStr
iMsg.Display
End SubMatt

[JeffT]

mvidas

Thanks for the reply, I'm running everything from outlook. The code works fine but it isn't what I'm trying to do.

I'm trying to make it possible so that whatever you type in the InputBox is memorized somewhere, and then whenever you open a new e-mail, this is used to complete the subject line.

I wondered if you can use a macro to edit another macro. From the total silence in my first post on the subject I guess not. This is when I had the idea of perhaps first pasting the subject line into a spreadsheet cell then copying this back into the subject line when running the macro, perhaps keeping it in memory for the whole outlook session.

Hopefully you can understand what I'm thinking even if the terminology isn't correct. I'm afraid I don't have a deep understanding of the mechanics of how VBA works just enjoy it!

regards

Jeff t

[mvidas]

Ahh, I understand now.

"macro to edit another macro" -- this would be possible in most VBA environments, however not in outlook VBA. There is no easy programmatic access for something like this.

However, it is possible to accomplish what you want to do. There are 3 ways I can think of at the moment, I'll go from least recommended to most recommended.

1) Storing the subject line during the outlook session. This is possible using a global variable (among other things). You could have it look in a specific cell of a specific workbook, or even just have an Inputbox popup when outlook is first opened using the application_startup event of ThisOutlookSession.

2) Store the desired subject line in the registry. The code could check a specific spot of the registry (one created just for this). If the entry exists, use that as the subject line. If not, an inputbox can pop up asking for it (then subsequently store it for future use).

3) Store the desired subject line in a text file on the users hard drive. This would act similarly to #2, however it would give the user the ability to edit it easier (they would simply have to open the text file in notepad or something).

Whichever route you decide to take (I can help you through any of them), you would use the following shell code:'*** Begin ThisOutlookSession CODE ***
Option Explicit

Sub Application_Startup()
vSubjectLine = GetSubjectLine
End Sub
'*** End ThisOutlookSession CODE ***
'*** BEGIN MODULE CODE ***
Option Explicit
Public vSubjectLine As String

Function GetSubjectLine() As String
'choice of subject retrieval goes here
End Function

Sub CreateNewMessage()
With Application.CreateItem(0) '0=olMailItem
.Subject = Format(Date, "yymmdd ") & vSubjectLine
.Display
End With
End Sub
'*** END MODULE CODE ***

[JeffT]

Thanks mvidas

Unfortunately I can't get the macro to work. If I run the CreateNewMessage macro from within VBA but if paste this into the button .OnAction = "CreateNewMessage" the button doesn't carry out any action.

I did have a problem with ThisOutlookSession as I already had a sub Application_Startup which acivates the toolbar buttons. (This is in fact a private sub, don't know why I copied it from elsewhere). I have put vSubjectLine = GetSubjectLine in here.

Next what am I supposed to put in 'choice of subject retrieval goes here?
I've tried to put the path to the text file in here but it just gives an error.

I was thinking of a spreadsheet as I wanted to put paths to different folders in different cells then reference buttons on a form to these cells for saving e-mails to different places. If a Text file could be used this would be fine but I don't know how to reference the buttons to different lines. this may be possible if so it would also be ok.

Hopefully this will go I've typed thsi 3 times but keep getting logged out for some reason.

Thanks again

Jeff T

[JeffT]

Thanks mvidas

Unfortunately I can't get the macro to work. If I run the CreateNewMessage macro from within VBA it works, but if paste this into the button .OnAction = "CreateNewMessage" the button doesn't carry out any action.

Sorry missed some important words

[mvidas]

Unfortunately I can't get the macro to work. If I run the CreateNewMessage macro from within VBA it works but if paste this into the button .OnAction = "CreateNewMessage" the button doesn't carry out any action. Hmmm.. is it possible you have more than one sub named CreateNewMessage?
Actually, after just trying to recreate the same thing I noticed that when manually adding a macro as a menu item it uses the project codename as well in it, like "Project1.CreateNewMessage". Try adding it manually (close VBE, right-click menu bar, Customize, Categories: Macros, then look in the available commands for the macro. If you have multiple macros of the same name you'll need to add the object name too. Looking in the customize section should help. In my experience, I've only added menu options via COM Addins, and use a custom event class rather than the .onaction (to call code from the addin rather than vbaproject.otm)


I did have a problem with ThisOutlookSession as I already had a sub Application_Startup which acivates the toolbar buttons. (This is in fact a private sub, don't know why I copied it from elsewhere). I have put vSubjectLine = GetSubjectLine in here.Thats fine, as long as the vSubjectLine variable gets filled at startup, adding it in your existing sub is perfect.


Next what am I supposed to put in 'choice of subject retrieval goes here?
I've tried to put the path to the text file in here but it just gives an error.I just put that as a 'shell' function, so you could decide which of the 3 options above you wanted to use.

For example, if you wanted to pull the subject line from a text file, you could use something like:Function GetSubjectLine() As String
Dim vFile As String, vFF As Long, tempStr As String
vFile = "C:\subject line.txt" 'file containing subject line
If Len(Dir(vFile)) = 0 Then 'file doesnt exist yet
'get subject from user
tempStr = InputBox("Please enter default subject line", "Enter subject")
'create text file and put subject into it for future uses
vFF = FreeFile
Open vFile For Output As #vFF
Print #vFF, tempStr;
Close #vFF
Else 'file exists, read subject from it
vFF = FreeFile
Open vFile For Binary Access Read As #vFF
tempStr = Space$(LOF(vFF))
Get #vFF, , tempStr
Close #vFF
End If
GetSubjectLine = tempStr
End Function
Using the registry would be basically the same thing, though would use a bit more code (no runtime difference really). I'll post that code if you're interested, but save thread space until then.

If you wanted to simply ask the user each time outlook is opened for their choice of subjects:Function GetSubjectLine() As String
GetSubjectLine = InputBox("Please enter default subject line", "Enter subject")
End Function

And to get it from an excel cell (though this may need to be modified a bit depending on how you want to do it, like have the file open all the time or whatever):Function GetSubjectLine() As String
Dim xlApp As Object, xlWB As Object, AppOpen As Boolean
Dim tempStr As String, xlFile As String
xlFile = "C:\excel file.xls"
On Error Resume Next
Set xlApp = GetObject(, "excel.application")
On Error GoTo 0
If xlApp Is Nothing Then
AppOpen = False
Set xlApp = CreateObject("excel.application")
Else
AppOpen = True
End If
xlApp.ScreenUpdating = False
Set xlWB = xlApp.workbooks.Open(xlFile)
tempStr = xlWB.sheets("Sheet1").Range("A1").Text 'cell with subject
xlWB.Close False
xlApp.ScreenUpdating = True
If Not AppOpen Then
xlApp.Quit
Set xlApp = Nothing
End If
End Function



I was thinking of a spreadsheet as I wanted to put paths to different folders in different cells then reference buttons on a form to these cells for saving e-mails to different places. If a Text file could be used this would be fine but I don't know how to reference the buttons to different lines. this may be possible if so it would also be ok.Not sure that I'm following you here.. do you want to list different folders and have your form automatically create buttons to save to different locations based on the list of folders? Or do you have a list of folders that you want to use based on the email sender or subject or something similar?

[JeffT]

Wow mvidas, I'm afraid this'll take a bit of time for me to digest. I'm completely self taught, with lots of help from you guys. (I need to buy a book solely on VBA to progress!) The # thing is completely new to me though I think I can follow the logic of most of your code. I'll use F8 to step through it to understand more fully what it does.

Re your queries. I don't think I'll go near the registry, to much to mess up I believe.

I will have button for the user to choose a path if all the others buttons are allocated to folders not required for a particular e-mail. I was going to try and bring up the Save or SaveAs dialog box, hopefully with it remembering where the last path went to during any outlook session.

The Form I've made has 5 tabbed pages each with 20 buttons. We use a 1 -30 folder structure on the server for each contract, and each of these has subfolders. Eg folder 10 is for subcontractors and we may have say 50 of these. The idea is to click on a button and the e-mail will be saved to a particular folder represented by that button. (Getting the button names from the spreadsheet would be useful as well!)

I want the form to pop up whenever an e-mail is closed or sent thus making it easy to file. However as different people, work on different contracts, we need to be able to easily change the path, so a default list won't work. Also using rules doesn't work cause the same subcontractor for instance may be used on different contracts.

To do this I was hoping to use a spreadsheet with 100 cells containing the different paths, linked to different buttons. I may use the Save box or similar so these could be added by selecting the path, but that'll be later.

Hopefully this isn't too long winded. I'll try out your code over the next few days, thank you very much for spending the time on my problem.

Regards

Jeff T

[mvidas]

Hi Jeff,

It definitely sounds possible. Before I make any stabs at implimenting this for you, I thought i'd expand on your "(Getting the button names from the spreadsheet would be useful as well!)" comment, to make it easiest for you.

Also, don't worry about being long-winded, as you can probably tell I do the same thing. More details = better, IMO. I'm self-taught too, so don't hesitate to ask if you have any questions

Anyways, you have a form with 5 tabs, and want 20 buttons each.
What would you say to having an excel sheet (or even just a text file, excel isnt necessary, just usually easy for most people to work with) with columns for "Tab name", "Button name", "Folder". The VBA could look through this, and dynamically add buttons (though if you will always have 20 buttons each, this isn't necessary) for each one listed per tab. With/without the dynamic buttons, the code can loop through the list, change the button name to the one specified, and change the linked directory as specified as well. I won't have the code look at that spreadsheet every time a button is clicked, but instead probably when the form is loaded and just store the folder data in memory. I'll think a little about that though

I have to admit that I have very little experience with outlook forms, only delving into them while helping others. Could cause a bit of a delay in helping you as i try and bring myself up to speed when needed

Do you have a network drive that you could store a 'master' spreadsheet that everyone's forms can pull from? I suppose we could get into that more later, just a thought

[JeffT]

mvidas

If I ever reach 1/100th of your knowlege I'll be happy!

What you say is exactly what I'm intending to do. I thought I'd have in column A the Tab names every 20th cell, Column B the button names, Column C the button Paths. Then on the spreadsheet I'd put a sort button which sorted columns B & C (& perhaps other Buttons which only sorted the individual Tab blocks of 20. This is because some people work on multiple contract and may want each tab to give their 20 "favorites" for each contract.) The sort function is so that the buttons can remain in alpha numeric order when some are added and some removed. (As a subcontractors completes the initial phase of construction they leave so their e-mail traffic dries up, and the finishing trades start so their e-mail traffic gets heavier.)

I was also going to add a cell, say near the top, which had the default path where the "Save As" button starts E.g N:\Contracts\3301.....

I was hoping that the links etc could be loaded at the start of each session. My intention is to open the spreadsheet using code in Outlook, and hope it opened quick enough for the links to be picked up, then it could close. If not I'd just tell everybody to open the spreadsheet first with a Yes No dialog box as Outlook opened. I've found some code on VBAX which can store a spreadsheet (or other file type) as though it were an e-mail within outlook itself so thought I'd put it here if the auto opening worked.

We do have a network N: drive so I could put the master there but IT / QA are very protective of what goes where. At first I'd just load it at the same time as I copy the various Modules etc into the correct places on each computer. (I have no idea how to write a programme to self install, I just want to get this out into use at first so that people start filing e-mails instead of them remaining on individual computers.)

Thank's for your continued interest.

Jeff

[mvidas]

Unfortunately I don't have the time today to look any more at this, but I should have a little more time tomorrow (~17 hours from now). Posting a message here just so it pops up on my new thread list wouldn't be a bad idea (keep me honest :)). A couple quick things though

I can write it so the excel file never actually opens in excel, using ADO (treating the excel file like a database). This should eliminate any two users having it open at the same time (of course, it could always just be opened read-only to prevent this too).

To have the Save As button start in a particular directory, the ChDir command in VBA can be used (ie ChDir "N:\Contracts" )

If you have access to VB6 you can make an outlook add-in, which will prevent the user from having to enable macros and also prevent you from having to copy the module/etc onto each.

Storing the spreadsheet in an email in Drafts isn't a bad idea, though I think having a master would be easiest overall (except, it does sound like your users will want the buttons in different orders).

Lastly, is this form you have all this on just a userform in VBA, or is it a 'custom outlook form'?

[JeffT]

Any time you have will be gratefully received, I'll just continue to play with what you've already given me thanks.

I've just Googled ADO having no idea what this is, now I'm a tiny bit wiser. If the Excel file is never opened how would people be able to populate it? I presume some type of form opens allowing the data to be entered. This is getting beyond my capability. I was thinking of using something like screenupdating = False .... = True, though I realise this may not work crossing between different applications. I don't think I can have 2 people using the same Excel file as different people will want different folder options.

I'll have a look at ChDir, however again different people may want to start with different folders. Some may want N:\Tenders some N:\Contracts (& we have more!). Perhaps ChDir can accomodate this I'll try.

I'm afraid I don't have VB6. I may try it if it helps but would probably need to be more proficient at VBA first.

The form I have is a userform in VBA, I'm afraid I don't know any other though will look at this as well if it'll help.

Jeff

[mvidas]

Re: ADO, heres a sub I made while exploring how it worked, and I use it as a basis of what I need to do anytime I want to interface excel/ado. Should give you a decent footing of what you can do, at least to read the file:Sub XLAdo()
'An example of how to use ADO to access an excel file.
' First it debug.print's the sheet names,
' Then debug.print's each cell value from the header row of the first sheet
' Then debug.print's each cell's value from every other cell in the first sheet
Dim xlConn As Object 'ADODB.Connection
Dim xlRS As Object 'ADODB.Recordset
Dim xlSheets As Object 'ADODB.Recordset
Dim xlFld As Object 'ADODB.Field
Dim vFile As String
Dim vSheet As String

'file location
vFile = "C:\ado.xls"

'connect to the file
Set xlConn = CreateObject("ADODB.Connection")
With xlConn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Extended Properties") = "Excel 8.0;IMEX=1"
.Open vFile
End With

'see sheet names in the immediate window
Set xlSheets = xlConn.OpenSchema(20) '20=adSchemaTables
While Not xlSheets.EOF
vSheet = xlSheets.Fields("TABLE_NAME").Value
Debug.Print vSheet
xlSheets.MoveNext
Wend
xlSheets.Close
Stop

'open recordset to get access to worksheet data
strSQL = "SELECT * From [" & vSheet & "]"
Set xlRS = CreateObject("ADODB.Recordset")
xlRS.Open strSQL, xlConn, 1, 1 '1,1=adOpenKeyset, adLockReadOnly

'see column names in the immediate window (first row with data)
For Each xlFld In xlRS.Fields
Debug.Print xlFld.Name
Next
Stop

'see cell values in the immediate window
While Not xlRS.EOF 'starts at 2nd row of data
For Each xlFld In xlRS.Fields
If Not IsNull(xlFld.Value) Then
Debug.Print xlFld.Value
End If
Next
xlRS.MoveNext
Wend

xlRS.Close
xlConn.Close
Set xlConn = Nothing
Set xlRS = Nothing
Set xlFld = Nothing
Set xlSheets = Nothing
End SubAs for populating it, it would still need to be done manually. It can be done programmatically, but in this scenario it isn't necessary.

If different people want different spreadsheets, then maybe this kind of thing isn't necessary, since you want to store the last directory looked at. Creating a separate instance of excel and keep it invisible might not be a bad option to have this functionality. But using ChDir and the last used directory's cell would work fine for different people if they all have their own 'helper' spreadsheet.

A VBA userform is what I know too, so keeping it that way is a good idea so I won't have to delve into custom forms again :)

Would you be able to export and attach the form you currently have, so I can just work with that instead of creating my own form to try and match yours?

[JeffT]

Mvidas thanks for the ADO code, I'll give it a go shortly to see what it does.

I managed to pick up the path from my spreadsheet using the last of your code posted on the 4th. I had to set tempStr to Public at the start of the Module to get the value to move between Modules (probably obvious to you but a learning point for me :) ). It doesn't seem as though it'll keep the value as looking at the value at the start of running the cde for a second time it shows "". I've looked at help and it seems I may have to change the variable to Static, I'm not sure but that's my next thing to try.

Is there a way to get a name on a button / Tab from the spreadsheet?

As requested I attach my form (I hope it's attached it's my first time trying). It seems that 2 files are created when I exported and as the file types aren't supported I've zipped them.

Hope that's correct

Regards

Jeff T

[mvidas]

Ok, I think you're gonna like this :)

I'm attaching "QuickFormFiles.zip", containing:
"clsQuickFormButton.cls" - Import this into your Outlook VBA project
"Quick_Form.frm" - Replace your current form with this
"Quick_Form.frx" - used automatically with .frm button
"SaveFormGuide.xls" - aforementioned spreadsheet

If you want to see it work right off the bat, save the SaveFormGuide.xls to your C:\ or change the FormGuideLocation constant to where yours is.

The _Click event for each button is located in the Class object clsQuickFormButton. Right now all I did was msgbox the 'Save To' directory so you can see it work, change this event accordingly.

Change the location of the FormGuideLocation constant in the form code, though the way this is retrieved will likely need to be changed to suit your users' needs. We can deal with that later, if you need help with it. If you already have a public variable holding it, then simply remove the Const line and change the reference to "FormGuideLocation" in the GetQuickFormData function to whatever your public variable is.

In the .xls file, you're probably going to want to hide Column A so your users dont change it (or just instruct them not to).
In a nutshell, here is what is happening:
-When the form is loaded, it looks at the .xls file and loads all the data from the first sheet.
-It then loops through the data for the button named PageXButtonY (you know what I mean) based on the PageCt and ButtonCt loops in UserForm_Initialize
-Once it finds that, assuming it is on the correct Tab name, it sets the button caption to what is listed in Column C.
-It then equates the commandbutton to a newly created instance of the class, and puts the save folder location into the class' vSaveFolder variable for use by the Click event in the class

I'm not sure if anything else in the thread above has not been mentioned, so I'll just wait to see if you have any more questions rather than read through it again and see what is unanswered.

I'm sure a lot of this is new to you, so play around with it and feel free to ask questions!

[JeffT]

Matt

This is amazing. It'll take me a while to understand it all I'll have a big play / tryout tommorow, Plus my New VBA book arrived today so I'm in heaven. Thanks so much for your help.

Thanks also replying to my other post. Once one problem's solved another always seems to crop up!! Still that's half the fun.

Jeff T

[JeffT]

Matt

This is really brilliant, how so little code can do so much. I'm still trying to understand everything about how it works but I'm gettin there.

I do have one problem. Everything has been working fine till tonight I started to tidy up all the comments and add some error catching dialog boxes. I've obviously deleted or changed something and can't figure out what.

From the Class module "clsQuickFormButton" it picks up the Path to the folder vSaveFolder. I want to pass this string to the 'Save' Module. I've got the following in the class Module:-

Path = vSaveFolder 'Both declared as Public As String

Call SaveSelectedEmails

As soon as the Module SaveSelectedEmails opens I've lost the String of the Path. I've tried amending lots of things and have probably made it worse. I guess it must be simple as it was working fine.

I've added the two modules in a Zip file in case this makes it easier to understand. I apologise in advance for the mess in the code.

Hope you can help as I was going public with this on Monday.

regards

Jeff

[mvidas]

Hi Jeff,

Since "Path" is already a public variable in your standard module, simply remove this line from the class:Public Path As StringHaving it in there is making a Path property of the class.. removing that should get it to work.

Another thing you could do (and avoid having to use a public variable) is to remove both instances of the above line (in the class module and standard module), then changing your sub declaration line to be:Sub SaveSelectedEmails(Optional Path As String)Then change the _Click event of the class to be:Private Sub vButton_Click()
Call SaveSelectedEmails(vSaveFolder)
End SubThat will send the vSaveFolder to the SaveSelectedEmails subroutine. FYI - The example file made it very easy to understand :)

[JeffT]

Thanks Matt. All working again.

I didn't originally have :-


Public Path As String

in the class, just one of my clumsey attempts to get it working again.

I've another question, how do I call the SaveAs dialog box? amending the code I use in Excel doesn't seem to work & I can't find it in the help file, my new book or by searching vbax. I was going to use the .Display method and use the path in my already written SaveSelectedEmails Sub.

Thanks again for your help. I'm about to update your excel file to add a 'User page' rather than changing the code page directly.

Jeff

[mvidas]

There is no native GetOpenFilename vba function like excel or word has, but you can use some API calls to get the same thing:Option Explicit
Public Declare Function GetOpenFileNameB Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Public Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Sub GetOpenFilenameExample()
Dim vFile As String
vFile = GetOpenFileName()
If vFile <> "" Then MsgBox vFile
End Sub

Public Function GetOpenFileName(Optional ByVal vFileFilter As String, Optional ByVal _
vWindowTitle As String, Optional ByVal vInitialDir As String, Optional ByVal _
vInitialFileName As String) As String
Dim OFN As OPENFILENAME, retVal As Long
OFN.lStructSize = Len(OFN)
OFN.hwndOwner = 0
OFN.hInstance = 0
OFN.lpstrFile = IIf(vInitialDir = "", Space$(254), vInitialDir & Space$(254 - Len(vInitialDir)))
OFN.lpstrInitialDir = IIf(vWindowTitle = "", CurDir, vInitialDir)
OFN.lpstrTitle = IIf(vWindowTitle = "", "Select File", vWindowTitle)
OFN.lpstrFilter = IIf(vFileFilter = "", "All Files (*.*)" & Chr(0) & "*.*", _
Replace(vFileFilter, ",", Chr$(0)))
OFN.nMaxFile = 255
OFN.lpstrFileTitle = Space$(254)
OFN.nMaxFileTitle = 255
OFN.flags = 0
retVal = GetOpenFileNameB(OFN)
If retVal Then GetOpenFileName = Trim$(OFN.lpstrFile)
End Function

For the flags (this is unnecessary), you can use the following constants. I usually use &H80000 for the flag to give it the new look with the desktop/mydoc/etc icons on the side.
Private Const OFN_READONLY = &H1
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_SHOWHELP = &H10
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_NOREADONLYRETURN = &H8000&
Private Const OFN_NOTESTFILECREATE = &H10000
Private Const OFN_NONETWORKBUTTON = &H20000
Private Const OFN_NOLONGNAMES = &H40000
Private Const OFN_EXPLORER = &H80000
Private Const OFN_NODEREFERENCELINKS = &H100000
Private Const OFN_LONGNAMES = &H200000If you're going to put that into an existing module, make sure the Declare and Type parts above any of your own procedures.

Though I haven't redownloaded the form, I believe my code uses the first worksheet in the excel file. So if you're modifying the file, keep the code page first (I'm honestly not sure how the ADO code will work with hidden sheets, if you go that route, but I'd guess it would still work..?)

[JeffT]

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

[mvidas]

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

[JeffT]

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

[JeffT]

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

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

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.

[mvidas]

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:'put this near the top of saveselectedemails
Dim vFolder As MAPIFolder
Set vFolder = Application.Session.GetDefaultFolder(olFolderInbox).Parent.Folders("MailFile")

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



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:Dim WithEvents ItemsInSentFolder As Outlook.Items
Then to set that, use:Set ItemsInSentFolder = Application.Session.GetDefaultFolder(olFolderSentMail)
And to use it: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


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:'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

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 (http://msdn2.microsoft.com/en-us/library/ms630408.aspx) of the shell object: 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

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.

[JeffT]

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

[mvidas]

I'm not going anywhere, so whenever you get to it is fine with me :)

[JeffT]

Back Again!!

I've been running the Folder Picker code

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

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

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''''''''''''''


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

[mvidas]

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!):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 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

[mvidas]

As an addition, this is in regards to the "" at the end of BrowseForFolder:

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 (http://msdn2.microsoft.com/en-us/library/ms630424.aspx) 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.

[JeffT]

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

Private Sub Application_ItemSend

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

[mvidas]

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):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

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 likeIf Len(Trim(xArr(5, 0))) = 0 Then
YourSubjectVariable = "Default subject line"
Else
YourSubjectVariable = xArr(5, 0)
End IfIn case the user doesnt set it in the spreadsheet (or deletes it or something)

[JeffT]

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.

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


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 :-

Private Sub Application_Startup()

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
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

Which in my own simple way has pleased me.:)

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

Jeff

[mvidas]

Oops! Forgot the most important keyword...
Since "ItemsInSentFolder" is an Outlook.Items object, add .Items after the GetDefaultFolder:Set ItemsInSentFolder = Application.Session.GetDefaultFolder(olFolderSentMail).ItemsYeah, doesn't seem to work when you leave out the most important part of it :)

[JeffT]

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

[mvidas]

What line is generating that error? Usually that error means you are requesting a non-existing member of a collection, like requesting... ActiveExplorer.Selection.Item(3)...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

[JeffT]

Hi Matt

It fails here :-

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


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 :-

Sub Form() 'GetQuick_Form()
'This opens the Quick_Form

Load Quick_Form ' IT FAILS HERE
Quick_Form.Show

End Sub


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 :doh:

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

[JeffT]

Got my windows sorted out again and everything exported / old imported. Tommorow I'll start looking for the error.

Thanks

[JeffT]

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?

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

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

[JeffT]

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

[mvidas]

Hi,

Sorry for the delayed reply, havent signed on in a few days.

Regarding the button_click code, you can put the call code in the class which handles the _click for each button (easier and shorter than tons of individual events). The way I originally gave you the _Click code in the class was:Private Sub vButton_Click()
'reference vSaveFolder variable to retrieve folder to save to
MsgBox vSaveFolder
End SubIf you put the code in there it should trigger on every button's click.

As I was away for a few days and I'm sure you've made big changes and advances, so let me know if theres anything left you need help with :)

[JeffT]

Thanks for the above Matt. I did try to make it work but with no sucess. In the end to stop wasting more time I just made 100 statements one for each button. I may have another try later as I can't see why it wouldn't work.

I've basically finished everything now just updateing the Word help file after fixing my last error catcher tonight.

However (isn't there always) I decided to put another button on my toolbar to open the spreadsheet for easier editing, but I just can't make it work. The code I have for the Help Word doc functions correctly but using this as a basis, the code for the Excel doc just keeps jumping to the error statement. Could you advise where I'm going wrong. The two codes are below.


Sub Help() 'this opens the "Help" word.doc in the Mailfile folder (path below)
Dim wd As Object
Dim HelpPath As String
Dim AppOpen As Boolean
Dim ErrorMessage As Long
HelpPath = "C:\MailFile\MailFileHelp.doc"

On Error GoTo Message

Set wd = GetObject(, "word.application") 'Checks to see if the file is already open
wd.Documents.Open HelpPath 'and opens the file

wd.Visible = True

wd.Application.Activate 'Makes the application have the focus

GoTo NoMessage
Message:
ErrorMessage = MsgBox(" The help file could not be opened." & vbCr & vbCr & _
"Check that the file MailFileHelp.doc is in the folder " & vbCr & vbCr & _
" C:\MailFile\", vbOKOnly + vbExclamation, "Help file not found")
NoMessage:
Set wd = Nothing
End Sub


Sub Excel() 'this opens the MailFile.xls settings file in the Mailfile folder (path below)
Dim myXL As Object
Dim SettingPath As String
Dim AppOpen As Boolean
Dim ErrorMessage As Long

SettingPath = "C:\MailFile\MailFile.xls"

On Error GoTo Message

Set myXL = GetObject("C:\MailFile\MailFile.xls") 'Checks to see if the file is already open
'Set myXL = GetObject(, "Excel.application") 'Checks to see if the file is already open
myXL.Workbooks.Open SettingPath 'and opens the file

myXL.Visible = True

myXL.Application.Activate 'Makes the application have the focus

GoTo NoMessage
Message:
ErrorMessage = MsgBox(" The settings file could not be opened." & vbCr & vbCr & _
" Check that the file MailFile.xls is in the folder " & vbCr & vbCr & _
" C:\MailFile\", vbOKOnly + vbExclamation, "Excel file not found")
NoMessage:
Set myXL = Nothing
End Sub



(I hate asking this as it must be something very basic but I've tried lots of things and nothing seems to work)

I'll post the completed programme as soon as I've done the help

Thanks

Jeff

[mvidas]

Hi Jeff,

The commented version of the GetObject in the excel one is the correct one (comma first, then excel.application). However, the logic in what you're doing might need to be a little changed, as far as the error checking goes.

Typically, I will check to see that a file exists first. If it does, then I'll see if the application is already open. If it isn't, I open it. Then I open the desired file. I've changed your word one a little bit, give it a try:Sub Help() 'this opens the "Help" word.doc in the Mailfile folder (path below)
Dim wd As Object
Dim HelpPath As String

HelpPath = "C:\MailFile\MailFileHelp.doc"

'check to see the file exists
If Len(Dir(HelpPath)) = 0 Then
MsgBox " The help file could not be opened." & vbCrLf & _
"Check that the file MailFileHelp.doc is in the folder " & vbCrLf & _
" C:\MailFile\", vbOKOnly + vbExclamation, _
"Help file not found"
Exit Sub
End If

'check to see if word is already open
On Error Resume Next
Set wd = GetObject(, "word.application")
On Error GoTo 0
If wd Is Nothing Then
Set wd = CreateObject("word.application")
End If

'load the file
wd.Visible = True
wd.Documents.Open HelpPath 'and opens the file
wd.Application.Activate 'Makes the application have the focus

'release memory
Set wd = Nothing
End Sub


Along the same lines..Sub Excel() 'this opens the MailFile.xls settings file in the Mailfile folder (path below)
Dim myXL As Object
Dim SettingPath As String

SettingPath = "C:\MailFile\MailFile.xls"
If Len(Dir(SettingPath)) = 0 Then
MsgBox " The settings file could not be opened." & vbCrLf & _
" Check that the file MailFile.xls is in the folder " & vbCrLf & _
" C:\MailFile\", vbOKOnly + vbExclamation, _
"Excel file not found"
Exit Sub
End If

On Error Resume Next
Set myXL = GetObject(, "Excel.application")
On Error GoTo 0
If myXL Is Nothing Then
Set myXL = CreateObject("excel.application")
End If

myXL.Workbooks.Open SettingPath
myXL.Visible = True
myXL.ActiveWindow.Activate 'Makes the application have the focus

Set myXL = Nothing
End Sub

[JeffT]

Thanks for the code Matt it still didn't work completely but I moved one line so it now works. I can see your method is better rather than using the error to go to the message.

What appears to happen with your code and explains the problem with mine is with the wd code wd is never nothing whether word is open or not. it is always "Microsoft Word". In Excel it is nothing if it isn't open but "microsoft Excel" if it is. I wonder if is to do with Outlook using word as its e-mail editor. perhaps word is always open in the background.

Anyway I've finished the project and attach my results here. I'll probably play with it a bit more (just remembered one more error in that the mailfile toolbar opens if you open a word attachment must fix that as well did in my last version anyway). I've given you and the forum some recognition in the Help file. please advise if you want that removed. Its been an interesting journey and I've learn't a lot.

I'll post 3 zip files separately as they exceed the forum limit

Regards

Jeff

[JeffT]

This is the code I forgot in the first zip

[JeffT]

Part 1 of the help file. I hyperlinked it so it may not work when recombined

[JeffT]

Part 2 of the help file.

I apologise again for my coding ability. I've learn't a lot and will try to be better next time

Jeff

[mvidas]

Thats still quite impressive!

FWIW, you can change the modified date of a file (based on "When E-mails are saved in Windows, the “Date Modified” shown in Windows Explorer is the date saved, not the date of the E-mail" from your help file)
Sub AnExample()
Dim vFile As String, vDate As Date
vFile = "C:\jefft\MailFile.xls"
vDate = Now - 20 '20 days ago
UpdateModifiedTime vFile, vDate
End Sub
Sub UpdateModifiedTime(ByVal FilePath As String, ByVal NewModifiedTime As Date)
Dim sh As Shell, sf As Shell32.Folder, fi As Object
Dim pos As Long, vPath As String, vFile As String
pos = InStrRev(FilePath, "\")
vPath = Left(FilePath, pos)
vFile = Mid(FilePath, pos + 1)
Set sh = CreateObject("Shell.Application")
Set sf = sh.NameSpace(vPath)
Set fi = sf.ParseName(vFile)
fi.ModifyDate = NewModifiedTime
Set sh = Nothing
Set sf = Nothing
Set fi = Nothing
End Sub

As for the mention in the help file, you can feel free to keep it, or you can feel free to remove it. My suggestion says that you should remove it and get all the kudos for it (your idea, all I did was help to guide you, and you still did most of the work).

Very nice work though! :beerchug:

[JeffT]

Thanks again Matt. I'll have a play with that last code. If it does what I think it can then I may rewrite that portion of the code in Mailfile so the reverse date isn't needed. I'll have to get it passed the QA department. But if it does enable me to change the saved date to the received / sent date, you may have just changed how the company operates.: pray2:

Just one other thing, is there a book / website with all these wonderful bits of code in, for instance "UpdateModifiedTime", or do you just create them as required from scratch?

Regards

Jeff

[mvidas]

Generally I just create those from scratch, though the above was something I had in a little bag of tricks I've compiled, as I dont usually change the modified date on things. Google is your best bet for websites (if you cant find what you want here), since it will link you places like msdn, freevbcode.com, codeproject.com, etc that have lots of snippets and what not. Or you can always just ask :)

[JeffT]

Matt Back Again!!

I've loaded the programe on my Work computer and everything works fine except my Move code. This works on my home laptop where I have been doing the development.

What appears to happen is it doesn't recognise the

.Item(iItem).Move vFolder

stepping through the code it moves through the above but doesn't move it. It does copy the file to the server in the previous

.Item(iItem).SaveAs StrFile, 3

Part code below.

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 'This works

'Next
End With

SaveMsg:
'''' The "Move" code is below here '''''
With Outlook.ActiveExplorer.Selection 'Added for moving 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 = vbYes Then GoTo ExitSub 'This stops it moving the e-mail if you want to save again

If Message = vbNo Then Unload Quick_Form

If MoveToArchive = False Then GoTo NoMove 'To jump the Move code below if the form checkbox isn't ticked

.Item(iItem).MoveFile vFolder ' This doesn't Move the Mail This moves the mail if the box in the Form is ticked



It recognises the Archives as if I change their name I get my error message. Is it anything to do with Windows 2000 rather than XP which is all I can see is different between my system an work. (though the .Move method is still shown in the help, file not surprising as we both run Outlook 2003). I've tried replacing .Move with .MoveFile but that doesn't seem to work I think I need to add the Source which I've yet to do.

Regards

Jeff

[mvidas]

That is odd, especially since you're using the same version! The .move method wont go away, so I'm really not sure why it isnt moving it (especially since it isn't erroring). Oh, I see now there is an On Error statement in there, try taking that out (in SaveSelectedEmails):
' On Error Resume Next
With Outlook.ActiveExplorer.Selection
iItem = 1
Since you're not going to be looping with iItem, you may want to use your mItem variable instead of using the With block (also, you probably don't need 2 identical With blocks, though it isn't a big deal). But removing that On Error Resume Next (even temporarily) should help you figure out why the .Move isn't working.

Looking back more, I see the vFolder variable is being set with: On Error GoTo NoArchive 'This catches the error if either Archive isn't in place

If SentItem = True Then 'This is only true if the e-mail is a Sent Mail

Set vFolder = Application.Session.Folders("MailFile Sent") 'If true move it to this Archive
Else
Set vFolder = Application.Session.Folders("MailFile Inbox") 'If not move it to this archive
End If

MissArchive: 'After catching the error above the code continues from here

On Error GoTo 0 'This stops the On Error above from detecting any other errorsI see your .pst files are called "MailFile_Inbox", not sure if the space/underscore is causing the issue (perhaps your laptop either has both the space and underscore files..?)

ADDED: ok that doesn't make sense, since you'd go to the NoArchive line. Maybe you could change the above block to: On Error Resume Next 'This catches the error if either Archive isn't in place

If SentItem = True Then 'This is only true if the e-mail is a Sent Mail

Set vFolder = Application.Session.Folders("MailFile Sent") 'If true move it to this Archive
Else
Set vFolder = Application.Session.Folders("MailFile Inbox") 'If not move it to this archive
End If

On Error GoTo 0 'This stops the On Error above from detecting any other errors

If vFolder Is Nothing Then
strMsg = "The 'MailFile Inbox' and / or 'MailFile Sent' Archive folders" & vbCr & _
"are not present, but the 'Move' box is still ticked on the form." _
& vbCr & vbCr & "The E-mail will be saved to the server but not moved to the Archive." & vbCr & _
"Remove the tick or open the Archives. See the Help file for details"
Message = MsgBox(strMsg, vbOKOnly + vbCritical, "E-mail will not be moved.")

MoveToArchive = False 'This stops the Move if the archive files aren't present.
End If

Just brainstorming here, trying to help troubleshoot it :)

[JeffT]

Thanks for the suggestions Matt I'm away this weekend and may not have much time but I'll try your suggestions.

I'm taking both laptops and will try stepping through the code on both at the same time try to see any differences.

As for the _ in the archive name in the MailFile folder, it didn't make any difference on my home laptop and the work one recognises it without. I thought the position in my archives might have made a difference so renamed it "A mailfile Inbox" so it was at the top of the archives. I got my error message as I forgot to change the code, however I had no error when I changed the name in the code to match. I'll try the On Error GoTo 0

Thanks again (Should be working on a Bar type programme in MS Project but this is more interesting)

Jeff

[JeffT]

Matt

I think I understand why my mail won't move but can't figure out a way to make it work

First the move does work when a mail enters the Sent folder. The code for this works because the mail isn't actually opened it's detected within the ThisOutlookSession Sub ItemsInSentFolder_ItemAdd. The code runs, the item is saved on the server and moved to the archive.

With the Inbox mails the way I initiate the Save & Move is to Open the mail and then Close it. The Close action is picked up in the clsCloseEvent Private Sub oMailItem_Close.

The problem is all the code runs before the mail actually closes. This was bypassed by an On Error Resume Next statement. Removing this Error catcher gives me a "Method 'Move' of Object 'MailItem' failed" statement.

What I need to know is Is there an "AfterMailClosed" event or some way to initiate further code after the Private Sub oMailItem_Close is finished?

What I may try is to put another button on the open e-mail toolbar to initiate the Close outside of the class module then run the code from here.
I've only just thought of that so that will be tommorows attempt.

Regards

Jeff T

[JeffT]

Matt

Putting a new button on the open mail toolbar seems to have worked. I've tested as much as I can until I return to work tommorow, so hopefully all is now OK. I still don't know why the previous code worked on one computer and not the other. This new version seems to work on both.
:2jump: :2jump: :2jump: :2jump: :2jump: :2jump: :2jump: :2jump: :2jump: :2jump:

I'll post the revised code once I've checked it in case anybody is interested.

Next I'll have a go with your suggestion at #48 to change the modified date in Windows explorer. That should do away with the need for reverse dates.

regards

Jeff

[mvidas]

Your mass amount of bouncing smileys made me laugh upon seeing it :) Glad to hear the extra button worked -- you probably could have trapped the events of Inspector windows to wait until it closed, but as long as you have a working solution in a way you can understand, all is good.

Let me know your working solution when you get it, I can always just skim through it and see if I see anything that sticks out as inefficient or anything. I'm sure its fine though :)

[JeffT]

Thanks for the offer Matt I'm always willing to learn. I know I've still a long way to go. However things I'd now do differently (I hope).

I'd be a bit more cautious with On Error statements.

I use the GoTo far to much. I need to use ElseIF type statements.

When using the buttons on the Open Mail I've loaded them in clsInspector, I should have put them in A_Toolbar (perhaps this didn't work) but to delete them I've used code to delete each button in turn. This works but runs through the code 17 times to delete 5 buttons. I imagine it's checking each button name in turn. I should have used it's name I think.

In the quick form code I've used 100 subs to call each button click seperately. I just couldn't figure this out.

This is the first time I've used Class Modules so I'm not sure if all the code could go into 1 module. there's not much in two of them.

Anyway thanks for your help. I'll load the new code in this reply then the other bits (Help doc, Excel file & 2no Archives) in the next post.

Jeff :friends:

[JeffT]

Here's the rest of it.

Thanks again

Jeff