INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

VB/Macro Error with datasource

VB/Macro Error with datasource

(OP)
Hi!!
I have been trying to make this work with Word/Outlook 2003/2007. In 2003 it pulls the entire database (not filtering by Department code). It works beautifully in Word 2000. Any help will be greatly appreciated.

Private sIndicator As String  ' to contain the number for the list
                                ' selected: 1=Newsletter, 2=Holiday
                                ' Party, 3=Annual Report, 4=Annual
                                ' Meeting, 5=Member & 6-All Lists.

Private Sub cmdCloseAllFilesAndExitWord_Click()
    
    ' remind user to change back default printer
    MsgBox ("please change your default printer back now, " & _
            "then click OK to continue."), _
            vbOKOnly, "Change Printer Default Back"
    ' close the template document
    Documents.Close (wdDoNotSaveChanges)
    ' shut down the form
    Unload Me
    ' close Word
    Application.Quit
End Sub


Private Sub cmdSelectNewsletter_Click()
' Newsletter'
    sIndicator = 1                      ' set selection indicator
    DoItAll (sIndicator)                ' go build the labels
    cmdCloseAllFilesAndExitWord_Click   ' and exit the program
End Sub
Private Sub cmdSelectHolidayParty_Click()
' HoLiDaY_PaRtY
    sIndicator = 2      ' set selection indicator
    DoItAll (sIndicator)
    cmdCloseAllFilesAndExitWord_Click   ' and exit the program
End Sub
Private Sub cmdSelectAnnualReport_Click()
' Annual_Report'
    sIndicator = 3      ' set selection indicator
    DoItAll (sIndicator)
    cmdCloseAllFilesAndExitWord_Click   ' and exit the program
End Sub
Private Sub cmdSelectAnnualMeeting_Click()
' Annual_Meeting'
    sIndicator = 4      ' set selection indicator
    DoItAll (sIndicator)
    cmdCloseAllFilesAndExitWord_Click   ' and exit the program
End Sub
Private Sub cmdSelectBoardMember_Click()
' Board_Member'
    sIndicator = 5      ' set selection indicator
    DoItAll (sIndicator)
    cmdCloseAllFilesAndExitWord_Click   ' and exit the program
End Sub
Private Sub cmdEverything_Click()
' Everything'
    sIndicator = 6      ' set selection indicator
    DoItAll (sIndicator)
    cmdCloseAllFilesAndExitWord_Click   ' and exit the program
End Sub
'************************************************************
' this function tests a filename to see if it already exists.
' Function returns false if the filename does not exist
'************************************************************
Function dhFileExists(strFile As String) As Boolean
    dhFileExists = (Len(Dir(strFile)) > 0)
End Function

'*******************************************************************************
' this sub gives the user the option to print the resulting labels or to just
' save the Word document for printing/reviewing later outside of this program.
'*******************************************************************************
Private Sub GoDoTheList(sListName, sAbbrevName)

    Dim intOptions As Integer
    Dim strMessage As String    ' for 'are you sure you want to print"' message text
    Dim bytChoice As Byte       ' stores answer to 'want to print?' question
    Dim sFileDate As String     ' stores date for part of filename
    Dim sFileno As String       ' stores filename increment to be appended to name & date for filename
    '
    ' Put out are you sure you want to print list to labels msg to screen?
    strMessage = "Hit OK to print all of the " & sListName & " names to the printer now. " & _
                "(If printing directly to Avery forms put them in the printer tray now). " & _
                "If you don''t want to print now, hit CANCEL and your print file will be saved."
    intOptions = vbQuestion + vbOKCancel
    bytChoice = MsgBox(strMessage, intOptions)
    
    If bytChoice <> vbCancel Then   ' if Cancel not clicked than print it
'    bytChoice = MsgBox(strMessage, intOptions)
'    End If
    
'    If bytChoice <> vbNo Then                 'yup! then print
        ActiveDocument.PrintOut
    End If
'
' In any case, save the generated labels file for reference and possible future
' printing outside of this program.
    '
    ' get a date for the print file name
    sFileDate = Format(Now(), "mmddyy")
    sFileno = 1                     ' set the file # to start at 1
    '
    ' go thru increasing file numbers until you get the next available name to save
    Do While dhFileExists(sAbbrevName & "NamesPrintout" & sFileDate & "#" & sFileno & ".doc")
        sFileno = sFileno + 1
    Loop
    ActiveDocument.SaveAs (sAbbrevName & "NamesPrintout" & sFileDate & "#" & sFileno & ".doc")
    'ActiveDocument.Close

End Sub

'***********************************************************
' This function finishes setting up and does the mail-merge,
' saves and prints the list
'***********************************************************
Function DoItAll(sIndicator As String)

    Dim sListName As String     ' to contain the list name for plugging into the 'print now?' message
    Dim sAbbrevName As String   ' to contain an abbreviated list name for the O/P file name
    
    ' chg default prtr to avoid letter-head tray as default on the Xerox
    MsgBox ("Please Set your default printer to the HP printer (" & _
            "ie:Start - Settings - Printer), then click OK to " & _
            "continue"), vbOKOnly, "Set Default Printer"
    '
    ' Open the labels files and creates temps
    ChangeFileOpenDirectory "\\Server\Mail Lists\"
    Documents.Open FileName:="""MM Labels TemplateNN.doc"""
    ' Open up the form
    ' Set MM Labels Template.doc as the active document.
    ActiveDocument.MailMerge.UseAddressBook Type:="OLK"
    Windows(1).Activate
    '*********************************************************
    ' Do the selection of names and mail merge for labels
    '
    ' If MYContacts is not already linked (on first pass after
    ' program starts) this will invoke the PAB Link dialog box
    ' and the user must select MYContacts as the mail merge
    ' input file.
    '*********************************************************
    sIndicator = sIndicator
    '
    ' This case statement interrogates the sIndicator number to ID which
    ' list to select and set other variables to indicate which list is
    ' used in later code
    '
    Select Case sIndicator
        Case 1          ' Newsletter List was selected in the form
            Dim strSQL As String
            ActiveDocument.MailMerge.DataSource.QueryString = _
                "SELECT * FROM C:\~~\~~~_virtual_file_~~~.olk WHERE ((Department = 'N0000')) OR ((Department = 'N000M')) OR ((Department = 'N00A0')) OR ((Department = 'N00AM')) OR ((Department = 'N0R00')) OR ((Department = 'N0R0M')) OR ((Department = 'N0RA0')) OR ((Department = 'N0RAM')) OR ((Department = 'NH000')) OR ((Department = 'NH00M')) OR ((Department = 'NH0A0')) OR ((Department = 'NH0AM')) OR ((Department = 'NHR00')) OR ((Department = 'NHR0M')) OR ((Department = 'NHRA0')) ORDER BY Last_Name" _
                & ""
            sListName = "Newsletter"
            sAbbrevName = "Nwslttr"
        Case 2          ' Holiday Party List
            ActiveDocument.MailMerge.DataSource.QueryString = _
                "SELECT * FROM C:\~~\~~~_virtual_file_~~~.olk WHERE ((Department = '0H000')) OR ((Department = '0H00M')) OR ((Department = '0H0A0')) OR ((Department = '0H0AM')) OR ((Department = '0HR00')) OR ((Department = '0HR0M')) OR ((Department = '0HRA0')) OR ((Department = '0HRAM')) OR ((Department = 'NH000')) OR ((Department = 'NH00M')) OR ((Department = 'NH0A0')) OR ((Department = 'NH0AM')) OR ((Department = 'NHR00')) OR ((Department = 'NHR0M')) OR ((Department = 'NHRA0')) ORDER BY Last_Name" _
                & ""
            sListName = "Holiday Party"
            sAbbrevName = "HolPty"
        Case 3          ' Annual Report List
            ActiveDocument.MailMerge.DataSource.QueryString = _
                "SELECT * FROM C:\~~\~~~_virtual_file_~~~.olk WHERE ((Department = '00R00')) OR ((Department = '00R0M')) OR ((Department = '00RA0')) OR ((Department = '00RAM')) ((Department = '0HR00')) OR ((Department = '0HR0M')) OR ((Department = '0HRA0')) OR ((Department = '0HRAM'))OR ((Department = 'N0R00')) OR ((Department = 'N0R0M')) OR ((Department = 'N0RA0')) OR ((Department = 'N0RAM')) ((Department = 'NHR00')) OR ((Department = 'NHR0M')) OR ((Department = 'NHRA0')) ORDER BY Last_Name" _
                & ""
            sListName = "Annual Report"
            sAbbrevName = "AnnlRpt"
        Case 4          ' Annual Meeting List
            ActiveDocument.MailMerge.DataSource.QueryString = _
                "SELECT * FROM C:\~~\~~~_virtual_file_~~~.olk WHERE ((Department = '000A0')) OR ((Department = '00RA0')) OR ((Department = '0H0A0')) OR ((Department = '0HRA0')) OR ((Department = 'N00A0')) OR ((Department = 'N0RA0')) OR ((Department = 'NH0A0')) OR ((Department = 'NHRA0')) OR ((Department = '000AM')) OR ((Department = '00RAM')) OR ((Department = '0H0AM')) OR ((Department = '0HRAM')) OR ((Department = 'N00AM')) OR ((Department = 'N0RAM')) OR ((Department = 'NH0AM')) ORDER BY Last_Name" _
                & ""
            sListName = "Annual Meeting"
            sAbbrevName = "AnnlMtg"
        Case 5          ' Member List
            ActiveDocument.MailMerge.DataSource.QueryString = _
                "SELECT * FROM C:\~~\~~~_virtual_file_~~~.olk WHERE ((Department = '0000M')) OR ((Department = '000AM')) OR ((Department = '00R0M')) OR ((Department = '00RAM')) OR ((Department = '0H00M')) OR ((Department = '0H0AM')) OR ((Department = '0HR0M')) OR ((Department = '0HRAM')) OR ((Department = 'N000M')) OR ((Department = 'N00AM')) OR ((Department = 'N0R0M')) OR ((Department = 'N0RAM')) OR ((Department = 'NH00M')) OR ((Department = 'NH0AM')) OR ((Department = 'NHR0M')) ORDER BY Last_Name" _
                & ""
            sListName = "Member"
            sAbbrevName = "Mbr"
        Case 6          ' All Lists
            ActiveDocument.MailMerge.DataSource.QueryString = _
                "SELECT * FROM C:\~~\~~~_virtual_file_~~~.olk WHERE ((Department = 'NHRAM')) ORDER BY Last_Name" _
                & ""
            sListName = "Everything"
            sAbbrevName = "AllLists"
    End Select
    '
    ' All set up .. do the mail merge
    '
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .MailAsAttachment = False
        .MailAddressFieldName = ""
        .MailSubject = ""
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=True
    End With
    ActiveWindow.ActivePane.LargeScroll Down:=5
    ActiveWindow.ActivePane.VerticalPercentScrolled = 0
    '************************************************************************
    ' Set printouts to use Tray 2 (non Letter Head tray on MY network printer)
    '************************************************************************
    With ActiveDocument.PageSetup
    .FirstPageTray = wdPrinterLowerBin
    .OtherPagesTray = wdPrinterLowerBin
    End With
    
    '************************************************************************
    ' give the user the option to print or save the label document
    '************************************************************************
    GoDoTheList sListName, sAbbrevName ' Print and/or Save the labels
 
End Function

 

RE: VB/Macro Error with datasource

Quote:

Hi!!
I have been trying to make this work with Word/Outlook 2003/2007. In 2003 it pulls the entire database (not filtering by Department code). It works beautifully in Word 2000. Any help will be greatly appreciated.

Okay, so what is it NOT doing, or what error messages are you getting?  What's the problem?

For reference, here's Microsoft's information regarding changes from 2003 to 2007 that might help a little.  I'm guessing that's where your undocumented problem stems from:
http://technet.microsoft.com/en-us/library/cc179054.aspx

RE: VB/Macro Error with datasource

(OP)
Well, this reads several Contacts I have in Public Folder (Outlook) and it s suppose to check for the department code. For example, these codes refers to my Holiday Part Contacts=((Department = '0H000')) OR ((Department = '0H00M')) OR ((Department = '0H0A0')). So when I choose to print just my contact for the holiday party mail merge, only my contacts with these department codes will be merged into my document.
In Word/Outlook 2003 my entire Contacts Holiday Party, Annual Report, Annual Meeting... is being printed (all 1500+ entries). In Word/Outlook 2000 when I choose to merge my Holiday Party, it only brings the ones with the correct Department Code.

Thanks for your help.

RE: VB/Macro Error with datasource

Okay, so you're saying it worked fine in 2000, but not in 2003 or 2007, then.  In that case, you may need to look back at the changes in 2003 at least and possibly 2002, and/or XP.

Here's the change list for 2003:
http://technet.microsoft.com/en-us/library/cc178951.aspx

And from their bread crumbs or whatever at the top of the page, you should be able to sort/browse to to differences in each version... I'm guessing there's been a VBA changesomewhere in there giving you the headache.  It sounds like a filter option you're using changed somewhere along the line.  I'd try to help dig into it further for you, but I'm afraid I've not the time today.

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close