Macro not working under Vista

[twentw]

I've got a macro that saves emails as a text file. This was cobbled together
from various online sources with some small modifications since I know very
little about Visual Basic. In any event, I've been using this macro for
years with Outlook 2003 and 2007 under XP. I'm now trying to use it with
Outlook 2007 under Vista, and it doesn't work. All that happens is the
warning about accessing email information, I click "allow" and then nothing.
I'm thinking there's some security thing in Vista that's preventing
execution. I have macro security in Outlook turned off. UAC in Vista is
also turned off. Any ideas? I can post the code if that could be an issue.

 

[Ken Slovak - [MVP - Outlook]]

Show the macro code.

 

[twentw]

OK - Here it is:

'----------START OF CODE -----------
Public Declare Function apiGetUserName Lib "advapi32.dll" Alias
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long




Public Sub GetMails()


' extract the selected mail into .doc format

Printfile

' extract attachments from selected mail


ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing

End Sub



Public Function Printfile()

Dim objMessage As Object
Dim oiMail As MailItem
Dim strSubj As String
Dim objSelection As Outlook.Selection
Dim objOL As Outlook.Application
Dim i As Long
Dim fol As String

On Error Resume Next



' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")
' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection
For Each objMessage In objSelection
Set oiMail = objMessage

oiMailsubj = oiMail.Subject 'Subject
oimailsubj1 = RemoveChars(oiMail.Subject)
oiMailbody = oiMail.Body 'Body
oiMailsname = oiMail.SenderName 'Sender Name
oiMailsize = oiMail.Size 'Mail Size
oiMailattach = oiMail.Attachments.Count 'Attachment count
If IsEmpty(oiMailattach) Or oiMailattach = 0 Then
oiMailattach = "no"
Else
oiMailattach = "yes"

For iCtr = 1 To oiMail.Attachments.Count
oiMailattachname = oiMail.Attachments.Item(iCtr).FileName
Next iCtr
End If

oiMailrtime = oiMail.ReceivedTime 'Received Time
oiMailrtime1 = ReplaceSlash((oiMailrtime))
oiMailrtime2 = ReplaceColon((oiMailrtime1))

'This generates a new text file each time it is run. To keep adding to the
Text file

Set objDialog = CreateObject("SAFRCFileDlg.FileSave")

If oiMailsname = "John Doe" Then

objDialog.FileName = "C:\Sync\Email to " & oiMail.To & " " &
oiMailrtime2 & ".txt"
objDialog.FileType = "Text File"

intreturn = objDialog.OpenFileSaveDlg

If intreturn Then

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.CreateTextFile(objDialog.FileName)

objFile.WriteLine "Sender: John Doe"
objFile.WriteLine "To: " & oiMail.To
objFile.WriteLine "Subject: " & oiMailsubj
objFile.WriteLine "Cc: " & oiMail.CC
objFile.WriteLine "Size: " & oiMailsize
objFile.WriteLine "Attachment: " & oiMailattach
objFile.WriteLine "Attachment file name: " & oiMailattachname
objFile.WriteLine "Sent on: " & oiMailrtime
objFile.WriteLine "Body: " & vbCrLf & vbCrLf & oiMailbody

objFile.Close

Else

WScript.Quit

End If

Else

objDialog.FileName = "C:\Sync\Email from " & oiMailsname & " " &
oiMailrtime2 & ".txt"
objDialog.FileType = "Text File"

intreturn = objDialog.OpenFileSaveDlg


If intreturn Then

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.CreateTextFile(objDialog.FileName)

objFile.WriteLine "Sender: " & oiMailsname
objFile.WriteLine "To: " & oiMail.To
objFile.WriteLine "Subject: " & oiMailsubj
objFile.WriteLine "Cc: " & oiMail.CC
objFile.WriteLine "Size: " & oiMailsize
objFile.WriteLine "Attachment: " & oiMailattach
objFile.WriteLine "Attachment file name: " & oiMailattachname
objFile.WriteLine "Received on: " & oiMailrtime
objFile.WriteLine "Body: " & vbCrLf & vbCrLf & oiMailbody

objFile.Close

Else

WScript.Quit
End If
End If


Next


End Function



Function RemoveChars(Text As String) As String
Dim x As Byte
Const Unwanted = "\/?*.:<>" 'add other characters if needed
RemoveChars = Text
For x = 1 To Len(Unwanted)
RemoveChars = Replace(RemoveChars, Mid(Unwanted, x, 1), "")
Next
End Function

Function ReplaceSlash(Text As String) As String
Dim x As Byte
Const Unwanted = "/" 'add other characters if needed
ReplaceSlash = Text
For x = 1 To Len(Unwanted)
ReplaceSlash = Replace(ReplaceSlash, Mid(Unwanted, x, 1), "-")
Next
End Function
Function ReplaceColon(Text As String) As String
Dim x As Byte
Const Unwanted = ":" 'add other characters if needed
ReplaceColon = Text
For x = 1 To Len(Unwanted)
ReplaceColon = Replace(ReplaceColon, Mid(Unwanted, x, 1), ".")
Next
End Function
' ------------END OF CODE -------------

 

[Ken Slovak - [MVP - Outlook]]

Do you have an active and up to date AV program running on that Vista
machine?

Do you know exactly which line causes the warning message? Try stepping the
code to see that.

Offhand I'd suggest changing your declaration of the Outlook.Application
object from this:

Set objOL = CreateObject("Outlook.Application")

to this:

Set objOL = Application

See if that makes a difference when you use the trusted Application object
instead of an untrusted one.

 

[twentw]

I have no antivirus running on this machine.

I'm trying to step through the code, but maybe I'm doing something wrong.
The only line that gets highlighted is Public Sub GetMails(), then it's done.
This is the same on the machine the code is working on. Is there a way to
get it to step through the code line by line?

I tried changing it to Set objOL = Application, but the only difference is
that the access warning window doesn't pop up.

 

[Ken Slovak - [MVP - Outlook]]

Once you hit a breakpoint you can step your code using F8.

If you no longer get the access warning now that you're using the trusted
Application object, does the macro now work?

 

[twentw]

I stepped through the macro on two machines simultaneously - one with XP and
the other with Vista.

The first difference is that the "Allow" warning only comes up on the Vista
machine. I'm not sure if that's important.

The main difference comes at the "intreturn = objDialog.OpenFileSaveDlg"
line. This line opens a dialog box on the XP machine but does nothing on the
Vista machine. After that the XP machine steps through the "WriteLine" code,
whereas the Vista machine skips to "Else" and then "WScript.Quit".

Any ideas?

 

[Ken Slovak - [MVP - Outlook]]

According to the information from this MS blog:
http://www.microsoft.com/technet/scriptcenter/resources/qanda/oct07/hey1026.mspx
the dialogs you need for that aren't in Vista, and the code would work on XP
but not Vista.

 

[twentw]

So, what's the solution? It seems odd there would be no way to open a file
save dialog from within Outlook.

 

[Ken Slovak - [MVP - Outlook]]

Most likely you would have to use the Win32 API call for that.

The VB6 common files dialog OCX (comdlg32.ocx) isn't available in Vista as
confirmed at http://msdn.microsoft.com/en-us/vbrun/ms788708.aspx, so you
have to set up the needed structs and directly call the common files dialog
dll, which is what the OCX does (and probably also the scripting method).

The other alternative is if you have VB6 you can deploy the common files
dialog OCX to a Vista machine and then your script might work or you could
call the dialogs OCX instead of the dll.

For information on working with the common dialogs in VB go to
http://vbnet.mvps.org/ and display the table of contents and look at the
common dialogs section. VB MVP Randy Birch has a discussion of the Win32 API
structs and arguments needed plus some sample code. The code should work
with VBA code.

If you intend to use this in various applications you might want to create a
file save as dialog class that encapsulates the ugly parts and just exposes
methods and properties that mirror the methods and properties you're used
to.

Be aware that working directly with the calls in the API are a heck of a lot
more work than using the usual common dialogs OCX or scripting methods.