Biggles1
asked on
VBA Indentifying version of Access
I have an Access Application that runs in 2003, 2007 and 2010.
Some of the VBA code does not run the same in all three versions. How would the Application identify which version of Access is running so I can modify the code with an If then Else statement?
Biggles1
Some of the VBA code does not run the same in all three versions. How would the Application identify which version of Access is running so I can modify the code with an If then Else statement?
Biggles1
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
No surprise there.
The ability to export reports to PDF was added in A2007.
That's why I have this sub for A2007+
In A2003, that's not going to play, so life's more complex.
What you do in that case is have a PDF printer installed.
I have a mix of Adobe Acrobat and doPDF on the go.
It is VERY nice to have a .Caption property for the report created dynamically as that by default becomes the filename
You switch Access's printer to the PDF printer and render the document.
And then you switch the printer back. This uses the API code I posted earlier to keep tabs on the PDF queue.
After that, you have to automate Outlook to create the message and attach the newly created PDF.
First, you get an Outlook object the right way
https://www.experts-exchange.com/articles/17466/Properly-open-Outlook-as-an-Application-object-in-VBA.html
This code was simplified down from working code and so is not likely to be perfect.
Still, it gives the bones and the Google keywords to see how to use VBA to create an Outlook message
There's a big discussion of it here
https://www.experts-exchange.com/questions/28471183/Need-code-to-programmatically-send-an-email-in-MS-Access-that-will-work-in-Access-2K-as-well-as-current-versions.html
The ability to export reports to PDF was added in A2007.
That's why I have this sub for A2007+
Private Sub SaveAsOfficePDF(stDocName As String)
Dim FormatValue As String
If Application.Version > 11 Then
FormatValue = "PDF Format (*.pdf)"
Else
FormatValue = acFormatRTF
End If
Me.SentToPrint.Value = False
If Not stDocName Like "*QD*" Then
DoCmd.OpenReport stDocName, acPreview
DoCmd.OutputTo acOutputReport, stDocName, FormatValue, "c:\tempPdf\" & Reports(stDocName).Caption & ".pdf"
DoCmd.Close acReport, stDocName, acSaveYes
Else
DoCmd.Close acReport, stDocName, acSaveYes
DoCmd.OpenReport stDocName, acNormal
RenameAGenericReport (stDocName)
End If
End Sub
In A2003, that's not going to play, so life's more complex.
What you do in that case is have a PDF printer installed.
I have a mix of Adobe Acrobat and doPDF on the go.
It is VERY nice to have a .Caption property for the report created dynamically as that by default becomes the filename
You switch Access's printer to the PDF printer and render the document.
And then you switch the printer back. This uses the API code I posted earlier to keep tabs on the PDF queue.
Private Sub CreatePDF(stDocName As String)
If Application.Version > 11 Then
Call SaveAsOfficePDF(stDocName)
Exit Sub
End If
Dim OldDefaultPrinterName As String
Dim NewPrinterName As String
Dim OldDefaultPrinterIndex As Integer
Dim NewPrinterIndex As Integer
Dim x As Integer
'Get the existing printer name to set the app default back to later
OldDefaultPrinterName = Application.Printer.DeviceName
NewPrinterName = "Adobe PDF"
Dim prtLoop As Printer
x = 0
For Each prtLoop In Application.Printers
With prtLoop
If .DeviceName = OldDefaultPrinterName Then
OldDefaultPrinterIndex = x
ElseIf .DeviceName = NewPrinterName Then
NewPrinterIndex = x
End If
End With
x = x + 1
Next prtLoop
'now change the printer to adobe pdf and print
Set Application.Printer = Application.Printers(NewPrinterIndex)
Set Application.Printer = Application.Printers("Adobe PDF")
'MsgBox "changed to " & Application.Printer.DeviceName
DoCmd.OpenReport stDocName, acPreview
DoCmd.OpenReport stDocName, acNormal
DoCmd.Close acReport, stDocName, acSaveYes
Dim Wait As Double
Wait = Timer + 5
'MsgBox Application.Printer.DeviceName
'now these structures pause things up until the job spools up and completes
'what happens if the default printer never gets the job, or can complete it before it gets here?
'it hangs, that's what!
'gotta fix that.
Do While GetPrinterDetails("Adobe PDF").Jobs = 0 And Timer < Wait
If GetPrinterDetails("Adobe PDF").Jobs > 0 Then
Exit Do
End If
DoEvents 'wait for spooling to start
'wait = wait + 1
'MsgBox wait & " " & Timer
'MsgBox GetPrinterDetails("Adobe PDF").Jobs
Loop
spooling:
Wait = Timer + 5
Do Until GetPrinterDetails("Adobe PDF").Jobs = 0 And Timer > Wait
If GetPrinterDetails("Adobe PDF").Jobs = 0 Then
Exit Do
End If
DoEvents 'wait til spooling is complete
'wait = wait + 1
'MsgBox wait & " " & Timer
Loop
'then change the printer back
Set Application.Printer = Application.Printers(OldDefaultPrinterIndex)
'MsgBox "changed back to " & Application.Printer.DeviceName
'If fs.FileExists("\\sb2008\customer\schl\pdf\" & Forms!frmjobID![WO#] & " FR3.pdf") = False Then
Select Case True
Case fs.FileExists("c:\temppdf\" & Forms!frmJobID![wo#] & " FR4.pdf")
fs.CopyFile "c:\temppdf\" & Forms!frmJobID![wo#] & " FR4.pdf", "\\sb2008\customer\schl\pdf\" & Forms!frmJobID![wo#] & " FR3.pdf", True
Case fs.FileExists("c:\temppdf\" & Forms!frmJobID![wo#] & " FR 4.pdf")
fs.CopyFile "c:\temppdf\" & Forms!frmJobID![wo#] & " FR 4.pdf", "\\sb2008\customer\schl\pdf\" & Forms!frmJobID![wo#] & " FR3.pdf", True
Case fs.FileExists("c:\temppdf\" & Forms!frmJobID![wo#] & " FR3.pdf")
fs.CopyFile "c:\temppdf\" & Forms!frmJobID![wo#] & " FR3.pdf", "\\sb2008\customer\schl\pdf\" & Forms!frmJobID![wo#] & " FR3.pdf", True
Case fs.FileExists("c:\temppdf\" & Forms!frmJobID![wo#] & " FR 3.pdf")
fs.CopyFile "c:\temppdf\" & Forms!frmJobID![wo#] & " FR 3.pdf", "\\sb2008\customer\schl\pdf\" & Forms!frmJobID![wo#] & " FR3.pdf", True
Case fs.FileExists("c:\temppdf\" & Forms!frmJobID![wo#] & " FR2.pdf")
fs.CopyFile "c:\temppdf\" & Forms!frmJobID![wo#] & " FR2.pdf", "\\sb2008\customer\schl\pdf\" & Forms!frmJobID![wo#] & " FR3.pdf", True
Case fs.FileExists("c:\temppdf\" & Forms!frmJobID![wo#] & " FR 2.pdf")
fs.CopyFile "c:\temppdf\" & Forms!frmJobID![wo#] & " FR 2.pdf", "\\sb2008\customer\schl\pdf\" & Forms!frmJobID![wo#] & " FR3.pdf", True
End Select
'End If
Select Case ReturnComputerName
Case "itadmin1"
Call CloseAdobeWindow
Case "mobile3"
'Call CloseAdobeWindow
Case Else
Exit Sub
End Select
Sleep 1000
'Wait = Timer + 1
'Do Until Timer > Wait
' DoEvents 'wait a second
'Loop
Call CloseAdobeWindow
End Sub
After that, you have to automate Outlook to create the message and attach the newly created PDF.
First, you get an Outlook object the right way
https://www.experts-exchange.com/articles/17466/Properly-open-Outlook-as-an-Application-object-in-VBA.html
Option Compare Database
Option Explicit
Public wasOpen As Boolean
Function StartApp(ByVal appName) As Object
On Error GoTo ErrorHandler
Dim oApp As Object
wasOpen = True
Set oApp = GetObject(, appName) 'Error here - Run-time error '429':
Set StartApp = oApp
Exit Function
ErrorHandler:
If Err.Number = 429 Then
'App is not running; open app with CreateObject
Set oApp = CreateObject(appName)
wasOpen = False
Resume Next
Else
MsgBox Err.Number & " " & Err.Description
End If
End Function
And then make the email messagePublic Sub CreateAnEmail(reportcaption As String, ClientName As String, Optional Suppress As Boolean, Optional TheBodyText As String, Optional WantReadReceipt As Boolean)
'On Error Resume Next
Dim db As Database
Dim rs As Recordset
Dim ClientEmail As String
Dim DisplayMsg As Boolean
Dim AttachmentPath As String
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim objOutlookExplorers As Outlook.Explorers
Dim myarray() As String
Dim myaddresses() As String
Dim x As Integer
Dim fs As Object
Dim BuiltPath As String
Dim response As Integer
Do While GetPrinterDetails("Adobe PDF").Jobs > 0
DoEvents
Loop
myarray = Split(reportcaption, ";")
'MsgBox UBound(MyArray, 1)
DisplayMsg = True
'AttachmentPath = "c:\temp\" & ReportCaption & ".pdf"
If Nz(Suppress, False) <> True Then
MsgBox "The email is about to be created!" & vbCrLf & _
"If nothing appears to be happening, the Outlook security box may be hiding behind an open window." & vbCrLf & _
"Click the Outlook icon on the taskbar to bring it to the front, if necessary."
End If
Set objOutlook = StartApp("Outlook.Application")
Dim ns As Outlook.Namespace
Dim Folder As Outlook.MAPIFolder
Set ns = objOutlook.GetNamespace("MAPI")
Set Folder = ns.GetDefaultFolder(olFolderInbox)
Set objOutlookExplorers = objOutlook.Explorers
If wasOpen = False Then
objOutlookExplorers.Add Folder
Folder.Display
'done opening
End If
' Create the message.
'Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
If Not ClientName Like "*@*" Then
Set db = CurrentDb
Set rs = db.OpenRecordset("select [client email] from tblclients where [client name] = " & Chr(34) & ClientName & Chr(34) & ";", dbOpenDynaset, dbSeeChanges)
If rs.RecordCount <> 0 Then
ClientEmail = Nz(rs![Client Email], "")
Else
ClientEmail = ""
End If
rs.Close
db.Close
Set db = Nothing
Set rs = Nothing
Else
ClientEmail = ClientName
End If
If Nz(ClientEmail, "") <> "" Then
' Add the To recipient(s) to the message.
myaddresses = Split(ClientEmail, ";")
For x = LBound(myaddresses) To UBound(myaddresses)
Set objOutlookRecip = .Recipients.Add(myaddresses(x))
objOutlookRecip.Type = olTo
Next x
End If
'can't do this, the mail never gets sent
' Add the from recipient(s) to the message.
'Set objOutlookRecip = .Recipients.Add(fGetFullNameOfLoggedUser())
'objOutlookRecip.Type = olOriginator
' Add the CC recipient(s) to the message.
'Set objOutlookRecip = .Recipients.Add(fGetFullNameOfLoggedUser())
'objOutlookRecip.Type = olCC
' Add the BCC recipient(s) to the message.
'Set objOutlookRecip = .Recipients.Add("Biggles1")
'objOutlookRecip.Type = olBCC
' Set the Subject, Body, and Importance of the message.
.Subject = "Requested report " & IIf(Len(reportcaption) < 161, reportcaption, Left(reportcaption, 159) & "...")
If Nz(TheBodyText, "") = "" Then
.body = "This is an automated sending by Biggles1 as requested." & vbCrLf & vbCrLf & _
"Please respond to Biggles1 with any inquiries"
Else
.body = TheBodyText
End If
'.Importance = olImportanceHigh 'High importance
' Add attachments to the message.
'reportcaption is passed in and split into myarray
'one attachment needs to be added for each element in myarray
For x = LBound(myarray, 1) To UBound(myarray, 1)
If Right(myarray(x), 3) = "xls" Then
AttachmentPath = "c:\tempPDF\" & myarray(x)
ElseIf reportcaption Like "*_cert.pdf" Then
AttachmentPath = reportcaption
Else
AttachmentPath = "c:\tempPDF\" & myarray(x) & ".pdf"
End If
'MsgBox reportcaption
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
Else
MsgBox "The attachment was not found or attached!"
End If
Next x
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
'Read receipt
If Nz(WantReadReceipt, False) = True Then
.ReadReceiptRequested = True
End If
' Should we display the message before sending?
If DisplayMsg Then
.Display
Else
.Save
.Send
End If
End With
Set objOutlook = Nothing
End Sub
This code was simplified down from working code and so is not likely to be perfect.
Still, it gives the bones and the Google keywords to see how to use VBA to create an Outlook message
There's a big discussion of it here
https://www.experts-exchange.com/questions/28471183/Need-code-to-programmatically-send-an-email-in-MS-Access-that-will-work-in-Access-2K-as-well-as-current-versions.html
ASKER
Nick: This is Excellent! Is there a way you can earn points for this additional information?
You really should have created another question because this is a different subject altogether from your original question. That way, others can benefit when they search for this particular topic; secondly, you may get a variety of responses on how to accomplish this; and lastly, you will be able to award points to the expert. I myself used a version of Leban's method that I modified (copyright intact) that converts a snapshot to a PDF so whenever I need a report as a PDF I use this function:
Public Sub ConvertToPDF(rptName As String, pdfName As String, folderPath As String)
'Create a snapshot of the report & save it in the current database path. Don't show snapshot.
DoCmd.OutputTo acOutputReport, rptName, "SNAPSHOT FORMAT (*.snp)", database_path & "\REPORT.SNP", False
Shell ("\\corpsrv01\pcbackup\ConverterSnapToPDF\ConvertSnapshotToPDF.exe " & database_path & "\REPORT.SNP," & pdfName & "," & folderPath)
End Sub
Ron
Is there a way you can earn points for this additional information?
I don't know if the 'good comment' button awards points or not.
And to me personally, the points are not that big a deal.
I am glad that you've gotten a handle on your problem and some new techniques.
DoCmd.SendObject is simple but very limited -- especially since you can only send a single report
Once you get a handle on how to automate Outlook many other possibilities open up.
Multiple files
Multiple sender types (CC and BCC)
HTML format mail
That last one is especially nice.
You can export a recordset to Excel, save the Excel as HTML and then TextStream the HTML to the .HTMLBody of a mail message and have formatted tables in the message body.
Lots of possibilities :)
I don't know if the 'good comment' button awards points or not.
And to me personally, the points are not that big a deal.
I am glad that you've gotten a handle on your problem and some new techniques.
DoCmd.SendObject is simple but very limited -- especially since you can only send a single report
Once you get a handle on how to automate Outlook many other possibilities open up.
Multiple files
Multiple sender types (CC and BCC)
HTML format mail
That last one is especially nice.
You can export a recordset to Excel, save the Excel as HTML and then TextStream the HTML to the .HTMLBody of a mail message and have formatted tables in the message body.
Lots of possibilities :)
ASKER
DoCmd.SendObject acSendReport, "rptInUnitMaintenanceInvoi
in 2003 only
DoCmd.SendObject acSendReport, "rptInUnitMaintenanceInvoi
works!
Unfortunately I have a customer who emails to a recipient who cannot read "Snapshot Format"!!