Solved

Issue with macro on Windows 7

Posted on 2010-11-19
32
341 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
 
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
Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
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

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Suggested Solutions

Today, still in the boom of Apple, PC's and products, nearly 50% of the computer users use Windows as graphical operating systems. If you are among those users who love windows, but are grappling to keep the system's hard drive optimized, then you s…
Not sure what the best email signature size is? Are you worried about email signature image size? Follow this best practice guide.
This Micro Tutorial will give you a introduction in two parts how to utilize Windows Live Movie Maker to its maximum capability. This will be demonstrated using Windows Live Movie Maker on Windows 7 operating system.
Office 365 is currently available in five editions. Three of them are for business use: Office 365 Business Essentials, Office 365 Business, and Office 365 Business Premium. Two of them are for home/personal use: Office 365 Home and Office 365 Perso…

762 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

Need Help in Real-Time?

Connect with top rated Experts

23 Experts available now in Live!

Get 1:1 Help Now