Solved

Issue with macro on Windows 7

Posted on 2010-11-19
32
346 Views
Last Modified: 2012-05-10
Good day everyone. I just installed about 4 computers with Windows 7 and those users were runningWindows Vista prior. They were running Office 2007 and they are still using Office 2007 on their new machines. For some reason, the following macro no longer compiles the information needed and sends out the emails. This is a macro incorporated in a Word document. It works fine on all the Windows Vista and XP machines I have tried in the office. What happens is when the macro is ran, it goes to an Access database and pulls names and other information to customize the document, it the creates an email attaches the word document and send sit out. It does this for as many people as are in the database.

I even went as far as Enabling all Macros (which is how their previous computers were set up but it still won't work. Any ideas how I can troubleshoot it or if you guys see anything that would conflidt with Windows 7?
ub ClientUpdate()
'
' ClientUpdate Macro
' Created by Philip Wong on 6/14/02
' Last modified by Philip Wong on 5/11/04
'
    frmSubject.Show
    GetData
    If fname <> "" Then
       For x = 1 To totalrec
          With ActiveDocument.MailMerge
             .Destination = wdSendToNewDocument
             .MailAsAttachment = False
             .MailAddressFieldName = ""
             .MailSubject = ""
             .SuppressBlankLines = True
             With .DataSource
                .FirstRecord = RecLocation(x)
                .LastRecord = RecLocation(x)
             End With
             .Execute Pause:=True
          End With
'          ChangeFileOpenDirectory "c:\development\Leg Merge\" & Foldername(x)
          ChangeFileOpenDirectory "\\SSC_SERVER2\DATA\Legislative Database\" & Foldername(x)
          ActiveDocument.SaveAs filename:=fname, FileFormat:=wdFormatDocument, _
             LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
             :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
             SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
             False
          ActiveWindow.Close
       Next x
    End If

    ActiveDocument.MailMerge.DataSource.QueryString = _
        "SELECT * FROM [Contacts] WHERE (([EmailName] IS NOT NULL ) AND ([ContactTypeID] = " & CID & "))" & _
         ""
    With ActiveDocument.MailMerge
        .Destination = wdSendToEmail
        .MailAsAttachment = True
        .MailAddressFieldName = "EmailName"
        .MailSubject = SubjectLine
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=True
    End With
    ActiveDocument.MailMerge.DataSource.QueryString = _
        "SELECT * FROM [Contacts] WHERE (([cc:Email1] IS NOT NULL ) AND ([ContactTypeID] = " & CID & "))" _
        & ""
    With ActiveDocument.MailMerge
        .Destination = wdSendToEmail
        .MailAsAttachment = True
        .MailAddressFieldName = "ccEmail1"
        .MailSubject = SubjectLine
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=True
    End With
    ActiveDocument.MailMerge.DataSource.QueryString = _
        "SELECT * FROM [Contacts] WHERE (([cc:Email2] IS NOT NULL ) AND ([ContactTypeID] = " & CID & "))" _
        & ""
    With ActiveDocument.MailMerge
        .Destination = wdSendToEmail
        .MailAsAttachment = True
        .MailAddressFieldName = "ccEmail2"
        .MailSubject = SubjectLine
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=True
    End With
    ActiveDocument.MailMerge.DataSource.QueryString = _
        "SELECT * FROM [Contacts] WHERE (([cc:Email3] IS NOT NULL ) AND ([ContactTypeID] = " & CID & "))" _
        & ""
    With ActiveDocument.MailMerge
        .Destination = wdSendToEmail
        .MailAsAttachment = True
        .MailAddressFieldName = "ccEmail3"
        .MailSubject = SubjectLine
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=True
    End With
    ActiveDocument.MailMerge.DataSource.QueryString = _
        "SELECT * FROM [Contacts] WHERE (([cc:Email4] IS NOT NULL ) AND ([ContactTypeID] = " & CID & "))" _
        & ""
    With ActiveDocument.MailMerge
        .Destination = wdSendToEmail
        .MailAsAttachment = True
        .MailAddressFieldName = "ccEmail4"
        .MailSubject = SubjectLine
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=True
    End With
    ActiveDocument.MailMerge.DataSource.QueryString = _
        "SELECT * FROM [Contacts] WHERE (([cc:Email5] IS NOT NULL ) AND ([ContactTypeID] = " & CID & "))" _
        & ""
    With ActiveDocument.MailMerge
        .Destination = wdSendToEmail
        .MailAsAttachment = True
        .MailAddressFieldName = "ccEmail5"
        .MailSubject = SubjectLine
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=True
    End With
    ActiveDocument.MailMerge.DataSource.QueryString = _
        "SELECT * FROM [Contacts] WHERE (([cc:Email6] IS NOT NULL ) AND ([ContactTypeID] = " & CID & "))" _
        & ""
    With ActiveDocument.MailMerge
        .Destination = wdSendToEmail
        .MailAsAttachment = True
        .MailAddressFieldName = "ccEmail6"
        .MailSubject = SubjectLine
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=True
    End With
    ActiveDocument.MailMerge.DataSource.QueryString = _
        "SELECT * FROM [Contacts] WHERE (([bc:Email1] IS NOT NULL ) AND ([ContactTypeID] = " & CID & "))" _
        & ""
    With ActiveDocument.MailMerge
        .Destination = wdSendToEmail
        .MailAsAttachment = True
        .MailAddressFieldName = "bcEmail1"
        .MailSubject = SubjectLine
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=True
    End With
    ActiveDocument.MailMerge.DataSource.QueryString = _
        "SELECT * FROM [Contacts] WHERE (([bc:Email2] IS NOT NULL ) AND ([ContactTypeID] = " & CID & "))" _
        & ""
    With ActiveDocument.MailMerge
        .Destination = wdSendToEmail
        .MailAsAttachment = True
        .MailAddressFieldName = "bcEmail2"
        .MailSubject = SubjectLine
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=True
    End With
    
End Sub

Open in new window

0
Comment
Question by:sscal
  • 15
  • 9
  • 4
  • +1
32 Comments
 
LVL 1

Author Comment

by:sscal
ID: 34175621
Here are the variables that I forgot to include at the top.
Public fname, SubjectLine As String
Public CID As Integer
Dim RecLocation(100) As Long
Dim Foldername(100) As String
Dim totalrec, x As Long

Open in new window

0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 34179800
If the macro no longer compiles, what is the error message, and what is highlighted?
0
 
LVL 1

Author Comment

by:sscal
ID: 34189215
The macro actually does compile because I get no visible error messages but the emails never get sent out. As if it was being blocked. Should I use the debug function to check for errors? I double checked the settings from the old mahcine to the new but I don't know if I am missing something.
0
Ransomware-A Revenue Bonanza for Service Providers

Ransomware – malware that gets on your customers’ computers, encrypts their data, and extorts a hefty ransom for the decryption keys – is a surging new threat.  The purpose of this eBook is to educate the reader about ransomware attacks.

 
LVL 76

Expert Comment

by:GrahamSkan
ID: 34189675
Sorry, I misread your question.

However, there are too many things going on outside of the code in the macro to be able to reproduce the problem. Have you tried stepping through the code to see what happens?
0
 
LVL 1

Author Comment

by:sscal
ID: 34189790
I have not. How do you do that?
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 34190036
Before starting, put a breakpoint on line 9 in your code with the F9 key. When the line is reached,  the macro will go into break mode. Press the F8 key. The current instruction should be execute, and then go into back into break mode, waiting for the F8 key again. Keep repeating this and you should be able to follow the flow.
0
 
LVL 1

Author Comment

by:sscal
ID: 34190059
Thank you very much. I will try this out and see what I notice.
0
 
LVL 1

Author Comment

by:sscal
ID: 34270793
So I finally got a chance to go through the macro in break mode and go through it step by step. No where does it fail or come up with any errors. The "A program is trying to send an email message..." prompt comes up and I click allow every time but nothng gets sent out through Outlook. When I do it thorugh a Vista or XP machine, it works just fine. I see no reason why I wouldn't be working in Windows 7.
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 34271024
It sounds as if the Word part is working OK, but the link between Word and Outlook is failing.

Is Outlook your default email application. Otherwise I can't think of any likely reason.
0
 
LVL 1

Author Comment

by:sscal
ID: 34271101
Outlook is the default email application on all computers. I can't think of anything else.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34322310
Is your Outlook Configured to send mail properly?

Sid
0
 
LVL 1

Author Comment

by:sscal
ID: 34322589
Everything in Outlook seems to work correctly. It worked just fine thorugh Vista and XP.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34322622
The "A program is trying to send an email message..." prompt comes up and I click allow every time but nothng gets sent out through Outlook.

ok try this...

Instead of sending the mail, try an d display it in Outlook. Are you able to achieve that?

Also check your outlook outbox. Hope the mails are not lying there?

Sid
0
 
LVL 1

Author Comment

by:sscal
ID: 34322656
I checked the Outbox and nothing ever gets there. Not sure what you mean by displaying it in Outlook??
0
 
LVL 37

Expert Comment

by:TommySzalapski
ID: 34322967
Have you tried it with all the antivirus and firewalls turned off?
0
 
LVL 1

Author Comment

by:sscal
ID: 34323166
I ahve not turned everything off like that but good point. I will give that a try.
0
 
LVL 30

Accepted Solution

by:
SiddharthRout earned 500 total points
ID: 34323225
Check this for me please...

Open word and go to VBE. Insert a module and paste the below code.

Please set a reference to the outlook object library...
Please also create a text file and name it "MyFile.txt"
Please amend the email address.

After you have done it, Please run it. What happens when you run it?

Sub Sample()
    Dim oOApp As Outlook.Application
    Dim oOMail As Outlook.MailItem

    Set oOApp = CreateObject("Outlook.Application")
    Set oOMail = oOApp.CreateItem(olMailItem)

    With oOMail
        .To = "EMAIL ADDRESS"
        .Subject = "SAMPLE"
        .Body = "SAMPLE"
        .Attachments.Add "C:\MyFile.txt", olByValue, 1
        .Send
    End With
End Sub

Open in new window


Sid
0
 
LVL 1

Author Comment

by:sscal
ID: 34354426
Sorry, I have been busy. I will try the above tomorrow.
0
 
LVL 1

Author Comment

by:sscal
ID: 34397422
I tried the macro today and this one went through just fine. It created the email, attached the text file, and sent it. No errors or hiccups.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34399330
So is your query solved?

Sid
0
 
LVL 1

Author Comment

by:sscal
ID: 34403608
The issue is not solved but it seems to be specific to the macro code on the word document we have. I will be looking at this further.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34403619
Maybe you can share the offending macro code?

Sid
0
 
LVL 1

Author Comment

by:sscal
ID: 34403628
I did share it. It is in the first post of the thread.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34403638
Oh Ok... I thought there is a different code....

Let me go through it again...

Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34403680
Hmmm... There are lot of sub functions...

Ok let's take it step by step...

Just keep one mail merge and delete the rest after line 49. Now check if it is Running

Sid
0
 
LVL 30

Assisted Solution

by:SiddharthRout
SiddharthRout earned 500 total points
ID: 34403749
Let's break it up into smaller pieces...

First Try this...

Sub ClientUpdate()
    frmSubject.Show
    GetData
    If fname <> "" Then
       'For x = 1 To totalrec
          With ActiveDocument.MailMerge
             .Destination = wdSendToNewDocument
             .MailAsAttachment = False
             .MailAddressFieldName = ""
             .MailSubject = ""
             .SuppressBlankLines = True
             With .DataSource
                .FirstRecord = RecLocation(x)
                .LastRecord = RecLocation(x)
             End With
             .Execute Pause:=True
          End With
          ChangeFileOpenDirectory "\\SSC_SERVER2\DATA\Legislative Database\" & FolderName(x)
          ActiveDocument.SaveAs Filename:=fname, FileFormat:=wdFormatDocument, _
             LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
             :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
             SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
             False
          ActiveWindow.Close
       'Next x
    End If
End Sub

Open in new window


Does this work?

If yes then try this

Sub ClientUpdate()
    frmSubject.Show
    GetData
    If fname <> "" Then
       'For x = 1 To totalrec
          With ActiveDocument.MailMerge
             .Destination = wdSendToNewDocument
             .MailAsAttachment = False
             .MailAddressFieldName = ""
             .MailSubject = ""
             .SuppressBlankLines = True
             With .DataSource
                .FirstRecord = RecLocation(x)
                .LastRecord = RecLocation(x)
             End With
             .Execute Pause:=True
          End With
          ChangeFileOpenDirectory "\\SSC_SERVER2\DATA\Legislative Database\" & FolderName(x)
          ActiveDocument.SaveAs Filename:=fname, FileFormat:=wdFormatDocument, _
             LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
             :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
             SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
             False
          ActiveWindow.Close
       'Next x
    End If

    ActiveDocument.MailMerge.DataSource.QueryString = _
    "SELECT * FROM [Contacts] WHERE (([EmailName] IS NOT NULL ) AND " & _
    "([ContactTypeID] = " & CID & "))"
    
    With ActiveDocument.MailMerge
        .Destination = wdSendToEmail
        .MailAsAttachment = True
        .MailAddressFieldName = "EmailName"
        .MailSubject = SubjectLine
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=True
    End With
End Sub

Open in new window


Sid
0
 
LVL 1

Author Comment

by:sscal
ID: 34403764
thank you. I will give this a try.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34664291
EXPERTS,
I need your help. Please post your closing recommendations within a few days. If you do not respond, I may need to assume that no correct answer was provided.
LeeTutor: I feel any of the code given in ID: 34403749 should work. Waiting for sscal's reply.

Sid
0
 
LVL 1

Author Comment

by:sscal
ID: 34666314
The code above would work. I am working on implementing this but have not had much opportunity. I will close this out.
0

Featured Post

Back Up Your Microsoft Windows Server®

Back up all your Microsoft Windows Server – on-premises, in remote locations, in private and hybrid clouds. Your entire Windows Server will be backed up in one easy step with patented, block-level disk imaging. We achieve RTOs (recovery time objectives) as low as 15 seconds.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You may have a outside contractor who comes in once a week or seasonal to do some work in your office but you only want to give him access to the programs and files he needs and keep privet all other documents and programs, can you do this on a loca…
Finding original email is quite difficult due to their duplicates. From this article, you will come to know why multiple duplicates of same emails appear and how to delete duplicate emails from Outlook securely and instantly while vital emails remai…
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

831 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question