Add to exsisting button

[daniels012]

I have a button on my form that Prints the current Work Order report.

Function PrintWOMacro()
On Error GoTo PrintWOMacro_Err

DoCmd.Echo False, ""
DoCmd.OpenReport "RptWorkOrder", acPreview, "", "[QryWorkOrder]![WorkOrderID]=[Forms]![FrmWorkOrderData]![WorkOrderID]"
If (Forms!FrmWorkOrderData!NoChargeWO = True) Then
Reports!RptWorkOrder!NoChargeWOLabel.Visible = True
End If
If (Forms!FrmWorkOrderData!NoChargeWO = True) Then
Reports!RptWorkOrder!NoChargeWO2.Visible = True
End If
DoCmd.PrintOut acPrintAll, 1, 1, acHigh, 1, True
DoCmd.Close acReport, "RptWorkOrder"


PrintWOMacro_Exit:
Exit Function

PrintWOMacro_Err:
MsgBox Error$
Resume PrintWOMacro_Exit

End Function
What code can i add to this code (and where) to also copy as a pdf file on the desktop. Basically I want it to make a copy into a folder on my desktop and then print.
I need the file name to be from the report: Report name = RptWorkOrder
The name of the file needs to be the field: PhysicalCompany then a space and then the field: WorkOrderID

Info: Using Office 2007, Folder on the desktop is "Clients"

Thannk You,
MIchael

[daniels012]

Here is what finally solved this:

Public Const CSIDL_DESKTOP = &H0
Private Type ****EMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As ****EMID
End Type
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Function GetSpecialfolder(CSIDL As Long) As String
Dim r As Long, Path$
Dim IDL As ITEMIDLIST
'Get the special folder
r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
If r = 0 Then
'Create a buffer
Path$ = Space$(512)
'Get the path from the IDList
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
'Remove the unnecessary chr$(0)'s
GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1)
Exit Function
End If
GetSpecialfolder = ""
End Function

And then modify your code to this:


Function PrintWOMacro()
On Error GoTo PrintWOMacro_Err

Dim strPhysicalCompany As String
Dim strWorkOrderID As String

DoCmd.Echo False, ""
DoCmd.OpenReport "RptWorkOrder", acPreview, "", "[QryWorkOrder]![WorkOrderID]=[Forms]![FrmWorkOrderData]![WorkOrderID]"
If (Forms!FrmWorkOrderData!NoChargeWO = True) Then
Reports!RptWorkOrder!NoChargeWOLabel.Visible = True
End If

strPhysicalCompany = Reports!RptWorkOrder!PhysicalCompany
strWorkOrderID = Reports!RptWorkOrder!WorkOrderID

If (Forms!FrmWorkOrderData!NoChargeWO = True) Then
Reports!RptWorkOrder!NoChargeWO2.Visible = True
End If

DoCmd.OutputTo acOutputReport, "RptWorkOrder", acFormatPDF, GetSpecialfolder(CSIDL_DESKTOP) & "\Clients\" & strPhysicalCompany & " " & strWorkOrderID & ".pdf"
DoCmd.PrintOut acPrintAll, 1, 1, acHigh, 1, True
DoCmd.Close acReport, "RptWorkOrder"

PrintWOMacro_Exit:
Exit Function
PrintWOMacro_Err:
MsgBox Error$
Resume PrintWOMacro_Exit
End Function

Thank You,
Michael