I am using Stephen Lebans PDF code. I have used this in several databases in the past without issue. I have recently rolled out a new database and used the DynaPDF code which works perfectly on my development computer (Windows 7).
However, when I copy the files (same file name, folder location, structure, etc.) to the deployment computer (running MS Server 2008) the code does not work - it simply will not load the DynaPDF.dll Library.
I've read several other posts and tried to copy the files to the System32 Folder as well as the same folder as the MSAccess.exe fie - all to no avail.
Any help will be appreciated.
Kind Regards,
Gunner
7 5565
Oddly enough, I added the reference folder to the same folder as the application and it worked. (despite the fact that I am still referencing the original .dll file which is no in this location.
zmbd 5,501
Expert Mod 4TB
dgunner71:
Normally, I'd say this was off topic for the forum; however, I see there's at least one thread in 2010ish dealing with it; thus, I'll leave this thread open for now... if you can give me a few more details (^-^)
Having used SL code once before, if I remember correctly, it worked with the SnapShot report method. However, my IT dept seeing the code said, please don't, we'll just add a PDF printer to everyone's PC and you can simply have a call to the printer dialog! (Love my IT guys... whenever they can, they do the best work for us!)
In ACC2010: Snapshot was officially removed from the program and replaced with native PDF support (which, btw, works pretty well - one of the better things MS did!!!) which is what I believe Stephen Lebans PDF code attempts to use. If this is the case, then if you are using 2010 (It is my understanding that ACC2007 with the servicepak that added PDF native support also removed snapshot) then SLPDF may very well fail.
I am afraid however that there is no more official support for any of SL applications:
---------- Lebans Holdings 1999 Ltd.RETIRED! September 2009
I have officially retired from all things Access. Please do not send Email requesting support as I will not respond.
Keep all of your questions to the Newsgroups where everyone will benefit
----------
By, simply stating that your code "doesn't work," and expecting someone to help doesn't usually result in much of an answer. Please tell us what you were expecting to happen, what actually happened, what version of Access/Office you are using, what operating system you are using, and finally, for each error: the EXACT title, error number, and descriptions that occurred and at what line in your posted code the error occurred. These are the minimum requirements for posting a question of this nature.
Thanks, zmbd.
The reason I was still using the snapshot instead of just calling a PDF printer is because I am sending a PDF via email automatically. (It's a Purchase Order) When the user clicks the email button, it creates a PDF report (and names it), then creates an email and attaches that PDF to the email.
What I was trying to do is to use the LoadLibrary() function to get this .dll loaded. However, despite verifying the location, the LoadLibarary() function just continued to respond as though the file was not in the location.
While it defies all logic, adding the reference file to the same folder as the .mdb file has corrected the issue. (even though I am still loading the .dll in the original location.
Gunner
zmbd 5,501
Expert Mod 4TB
Please show the modified code.
Also the version of ACC and the local OS on the PC's
As SL nolonger supports, you may have just help a few hundred people (or more). d(^_^)b
zmbd -
The code is below - this is the entire module to print to a PDF. Please search the code for 9*9*9*9*9*9*9 (I put this in as a beacon to find the code in question).
As I noted, the only thing I changed was I actually added a folder called "Reference" to the same folder as the front end.
The database was built in Access 2010. The server (where the database is being deployed) is 2013 downgraded to 2013. (I didn't install this, I was told by our IT folks.)
Gunner - Option Compare Database
-
Option Explicit
-
-
#Const ConDebug = 0 ' Set to 1 to force loading of DEBUG StrStorage.DLL
-
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
#If (ConDebug = 1) Then
-
-
Public Declare Function ConvertUncompressedSnapshot Lib "C:\VisualCsource\Debug\StrStorage.dll" (ByVal UnCompressedSnapShotName As String, _
-
ByVal OutputPDFname As String, Optional ByVal CompressionLevel As Long = 0, Optional ByVal PasswordOpen As String = "", _
-
Optional ByVal PasswordOwner As String = "", Optional ByVal PasswordRestrictions As Long = 0, _
-
Optional ByVal PDFNoFontEmbedding As Long = 0, Optional ByVal PDFUnicodeFlags As Long = 0) As Boolean
-
-
-
Public Declare Function DrawTableWindow Lib "C:\VisualCsource\Debug\StrStorage.dll" (ByVal TableName As String, ByVal Fields As String, _
-
ByVal NumFields As Long, ByVal Xpos As Double, ByVal Ypos As Double, ByVal Width As Double, ByVal Height As Double) As Long
-
-
-
Public Declare Function DrawLine Lib "C:\VisualCsource\Debug\StrStorage.dll" (ByVal Width As Double, ByVal Width1 As Double, ByVal Xpos As Double, _
-
ByVal Ypos As Double, ByVal Xpos1 As Double, ByVal Ypos1 As Double, ByVal Attrib As Long) As Long
-
-
-
Public Declare Function BeginPDF Lib "C:\VisualCsource\Debug\StrStorage.dll" (ByVal PDFfilename As String, ByVal PageWidth As Long, _
-
ByVal PageHeight As Long) As Long
-
-
-
Public Declare Function EndPDF Lib "C:\VisualCsource\Debug\StrStorage.dll" () As Long
-
-
-
Public Declare Function MergePDFDocuments Lib "C:\VisualCsource\Debug\StrStorage.dll" (ByVal PDFMaster As String, ByVal PDFChild As String) As Boolean
-
-
-
#Else
-
-
-
Public Declare Function ConvertUncompressedSnapshot Lib "StrStorage.dll" (ByVal UnCompressedSnapShotName As String, ByVal OutputPDFname As String, _
-
Optional ByVal CompressionLevel As Long = 0, Optional ByVal PasswordOpen As String = "", Optional ByVal PasswordOwner As String = "", _
-
Optional ByVal PasswordRestrictions As Long = 0, Optional ByVal PDFNoFontEmbedding As Long = 0, _
-
Optional ByVal PDFUnicodeFlags As Long = 0) As Boolean
-
-
-
Public Declare Function DrawTableWindow Lib "StrStorage.dll" (ByVal TableName As String, ByVal Fields As String, ByVal NumFields As Long, _
-
ByVal Xpos As Double, ByVal Ypos As Double, ByVal Width As Double, ByVal Height As Double) As Long
-
-
-
Public Declare Function DrawLine Lib "StrStorage.dll" (ByVal Width As Double, ByVal Width1 As Double, ByVal Xpos As Double, ByVal Ypos As Double, _
-
ByVal Xpos1 As Double, ByVal Ypos1 As Double, ByVal Attrib As Long) As Long
-
-
-
Public Declare Function BeginPDF Lib "StrStorage.dll" (ByVal PDFfilename As String, ByVal PageWidth As Long, ByVal PageHeight As Long) As Long
-
-
-
Public Declare Function EndPDF Lib "StrStorage.dll" () As Long
-
-
-
Public Declare Function MergePDFDocuments Lib "StrStorage.dll" (ByVal PDFMaster As String, ByVal PDFChild As String) As Boolean
-
-
-
#End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
-
Private Declare Function ShellExecuteA Lib "shell32.dll" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
-
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
-
-
-
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
-
-
-
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
-
-
-
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
-
-
-
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, _
-
ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
-
-
-
Private Declare Function SetupDecompressOrCopyFile Lib "setupAPI" Alias "SetupDecompressOrCopyFileA" (ByVal SourceFileName As String, _
-
ByVal TargetFileName As String, ByVal CompressionType As Integer) As Long
-
-
-
Private Declare Function SetupGetFileCompressionInfo Lib "setupAPI" Alias "SetupGetFileCompressionInfoA" (ByVal SourceFileName As String, _
-
TargetFileName As String, SourceFileSize As Long, DestinationFileSize As Long, CompressionType As Integer) As Long
-
-
-
-
'Compression types
-
Private Const FILE_COMPRESSION_NONE = 0
-
Private Const FILE_COMPRESSION_WINLZA = 1
-
Private Const FILE_COMPRESSION_MSZIP = 2
-
-
Private Const mConst_Pathlen = 256
-
Private Const mCosnt_MaxPath = 256
-
-
'Enum TKeyLen
-
Public Const kl40bit = 0 ' 40 bit RC4 encryption (Acrobat 3 or higher)
-
Public Const kl128bit = 1 ' 128 bit RC4 encryption (Acrobat 5 or higher)
-
Public Const kl128bitEx = 2 ' 128 bit RC4 encryption (Acrobat 6 or higher)
-
'End Enum
-
-
'Enum TRestrictions
-
Public Const rsDenyNothing = 0
-
Public Const rsDenyAll = 3900
-
Public Const rsPrint = 4
-
Public Const rsModify = 8
-
Public Const rsCopyObj = 16
-
Public Const rsAddObj = 32
-
' 128 bit encryption only -> these values are ignored if 40 bit encryption is used
-
Public Const rsFillInFormFields = 256
-
Public Const rsExtractObj = 512
-
Public Const rsAssemble = 1024
-
Public Const rsPrintHighRes = 2048
-
Public Const rsExlMetadata = 4096 ' PDF 1.5 -> can be used with kl128bitEx only
-
'End Enum
-
-
-
Public Type POINTAPI
-
X As Long
-
Y As Long
-
End Type
-
-
Public Type RECTL
-
Left As Long
-
Top As Long
-
Right As Long
-
Bottom As Long
-
End Type
-
-
Public Const AAAlength = 12
-
Public Const FFFlength = 8
-
Public Const Padding = 12
-
Public Const NameLengthMax = 128
-
' 64 Char MAX for a DAO Table Name * 2 = Unicode
-
-
Public Type RelBlob
-
Sig As Long
-
AAAs(1 To AAAlength) As Byte
-
RelWinX1 As Long
-
RelWinY1 As Long
-
RelWinX2 As Long
-
RelWinY2 As Long
-
Blank As Long
-
FFFs(1 To FFFlength) As Byte
-
ClientRectX As Long
-
ClientRectY As Long
-
'Pad(1 To Padding) As Byte
-
' These next 2 long values represent the Horiz and Vert ScrollBar positions(if any).
-
' These values must be added to the window coordinates stored in this Blob.
-
ScrollBarYoffset As Long
-
ScrollBarXoffset As Long
-
Pad1 As Long
-
NumWindows As Long
-
End Type
-
-
Public Type RelWindow
-
RelWinX1 As Long
-
RelWinY1 As Long
-
RelWinX2 As Long
-
RelWinY2 As Long
-
Junk As Long
-
WinName As String * NameLengthMax
-
Junk1 As Long
-
WinNameMaster As String * NameLengthMax
-
'Pad(1 To Padding) As Byte
-
Junk2 As Long
-
End Type
-
-
Public Type RelWindowMin
-
RelWinX1 As Long
-
RelWinY1 As Long
-
RelWinX2 As Long
-
RelWinY2 As Long
-
Column As Long
-
WinName As String
-
End Type
-
-
Public Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
-
-
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
-
-
Public Declare Function apiGetWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
-
-
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECTL) As Long
-
-
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _
-
ByVal cy As Long, ByVal wFlags As Long) As Long
-
-
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
-
-
Public Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
-
-
'Create an Information Context
-
Private Declare Function apiCreateIC Lib "gdi32" Alias "CreateICA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any) As Long
-
-
Private Declare Function apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hDC As Long, ByVal nIndex As Long) As Long
-
-
Private Declare Function apiDeleteDC Lib "gdi32" Alias "DeleteDC" (ByVal hDC As Long) As Long
-
-
-
'SetWindowPos() Constants
-
Public Const SWP_SHOWWINDOW = &H40
-
-
'GetWindow() Constants
-
Public Const GW_HWNDNEXT = 2
-
Public Const GW_CHILD = 5
-
-
'Device Parameters for GetDeviceCaps()
-
Private Const LOGPIXELSX = 88 ' Logical pixels/inch in X
-
Private Const LOGPIXELSY = 90 ' Logical pixels/inch in Y
-
-
-
'***********************************************
-
'Font, DC and TextWidth stuff
-
-
Private Type RECT
-
Left As Long
-
Top As Long
-
Right As Long
-
Bottom As Long
-
End Type
-
-
Private Const LF_FACESIZE = 32
-
-
Private Type LOGFONT
-
lfHeight As Long
-
lfWidth As Long
-
lfEscapement As Long
-
lfOrientation As Long
-
lfWeight As Long
-
lfItalic As Byte
-
lfUnderline As Byte
-
lfStrikeOut As Byte
-
lfCharSet As Byte
-
lfOutPrecision As Byte
-
lfClipPrecision As Byte
-
lfQuality As Byte
-
lfPitchAndFamily As Byte
-
lfFaceName As String * LF_FACESIZE
-
End Type
-
-
Private Type TEXTMETRIC
-
tmHeight As Long
-
tmAscent As Long
-
tmDescent As Long
-
tmInternalLeading As Long
-
tmExternalLeading As Long
-
tmAveCharWidth As Long
-
tmMaxCharWidth As Long
-
tmWeight As Long
-
tmOverhang As Long
-
tmDigitizedAspectX As Long
-
tmDigitizedAspectY As Long
-
tmFirstChar As Byte
-
tmLastChar As Byte
-
tmDefaultChar As Byte
-
tmBreakChar As Byte
-
tmItalic As Byte
-
tmUnderlined As Byte
-
tmStruckOut As Byte
-
tmPitchAndFamily As Byte
-
tmCharSet As Byte
-
End Type
-
-
Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hDC As Long, lpMetrics As TEXTMETRIC) As Long
-
-
Private Declare Function apiCreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
-
-
Private Declare Function apiSelectObject Lib "gdi32" Alias "SelectObject" (ByVal hDC As Long, ByVal hObject As Long) As Long
-
-
Private Declare Function apiDeleteObject Lib "gdi32" Alias "DeleteObject" (ByVal hObject As Long) As Long
-
-
Private Declare Function apiMulDiv Lib "kernel32" Alias "MulDiv" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
-
-
Private Declare Function apiGetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Long) As Long
-
-
Private Declare Function apiReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Long, ByVal hDC As Long) As Long
-
-
Private Declare Function apiDrawText Lib "user32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, _
-
ByVal wFormat As Long) As Long
-
-
Private Declare Function CreateDCbyNum Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As Long, _
-
ByVal lpInitData As Long) As Long
-
-
Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, _
-
ByVal lpReturnedString As String, ByVal nSize As Long) As Long
-
-
-
'CONSTANTS
-
Private Const TWIPSPERINCH = 1440
-
-
'DrawText() Format Flags
-
Private Const DT_TOP = &H0
-
Private Const DT_LEFT = &H0
-
Private Const DT_CALCRECT = &H400
-
Private Const DT_WORDBREAK = &H10
-
Private Const DT_EXTERNALLEADING = &H200
-
Private Const DT_EDITCONTROL = &H2000&
-
Private Const DT_NOCLIP = &H100
-
-
'Font stuff
-
Private Const OUT_DEFAULT_PRECIS = 0
-
Private Const OUT_STRING_PRECIS = 1
-
Private Const OUT_CHARACTER_PRECIS = 2
-
Private Const OUT_STROKE_PRECIS = 3
-
Private Const OUT_TT_PRECIS = 4
-
Private Const OUT_DEVICE_PRECIS = 5
-
Private Const OUT_RASTER_PRECIS = 6
-
Private Const OUT_TT_ONLY_PRECIS = 7
-
Private Const OUT_OUTLINE_PRECIS = 8
-
-
Private Const CLIP_DEFAULT_PRECIS = 0
-
Private Const CLIP_CHARACTER_PRECIS = 1
-
Private Const CLIP_STROKE_PRECIS = 2
-
Private Const CLIP_MASK = &HF
-
Private Const CLIP_LH_ANGLES = 16
-
Private Const CLIP_TT_ALWAYS = 32
-
Private Const CLIP_EMBEDDED = 128
-
-
Private Const DEFAULT_QUALITY = 0
-
Private Const DRAFT_QUALITY = 1
-
Private Const PROOF_QUALITY = 2
-
-
Private Const DEFAULT_PITCH = 0
-
Private Const FIXED_PITCH = 1
-
Private Const VARIABLE_PITCH = 2
-
-
Private Const ANSI_CHARSET = 0
-
Private Const DEFAULT_CHARSET = 1
-
Private Const SYMBOL_CHARSET = 2
-
Private Const SHIFTJIS_CHARSET = 128
-
Private Const HANGEUL_CHARSET = 129
-
Private Const CHINESEBIG5_CHARSET = 136
-
Private Const OEM_CHARSET = 255
-
-
' ***********************************************
-
-
'Allow user to set FileName instead of using API Temp Filename or popping File Dialog Window
-
Private mSaveFileName As String
-
-
'Full path and name of uncompressed SnapShot file
-
Private mConst_UncompressedSnapFile As String
-
-
'Name of the Report we ' working with
-
Private m_strReportName As String
-
-
'Instance returned from LoadLibrary calls
-
Private hLibDynaPDF As Long
-
Private hLibStrStorage As Long
-
'
-
'
-
'
-
-
-
Public Function gfx_ConvertReportToPDF(Optional strReportName As String = "", Optional strSnapshotName As String = "", Optional strOutputPDFname As String = "", _
-
Optional blnShowSaveFileDialog As Boolean = False, Optional blnStartPDFViewer As Boolean = True, _
-
Optional lngCompressionLevel As Long = 0, Optional lngPDFNoFontEmbedding As Long = 0, Optional lngPDFUnicodeFlags As Long = 0, Optional strType As String = "", Optional strFilePath As String = "") As Boolean
-
On Error GoTo Err_ErrorHandler
-
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
' Converts a Snapshot Report to PDF
-
-
' strReportName is the name of a report contained within this MDB
-
' strSnapshotName is the name of an existing Snapshot file
-
' strOutputPDFname is the name you select for the output PDF file
-
' blnShowSaveFileDialog is a boolean param to specify whether or not to display the standard windows File Dialog window to select an exisiting Snapshot file
-
' lngPDFNoFontEmbedding - Do not Embed fonts in PDF. Set to 1 to stop the default process of embedding all fonts in the output PDF.
-
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
Dim strSubCallingID As String
-
strSubCallingID = "modPDFCode : gfx_ConvertReportToPDF"
-
-
-
Dim strMonth As String
-
strMonth = IIf(Month(Now()) < 10, "0" & Month(Now()), Month(Now()))
-
-
'Ensure there is a folder for the Current Date and Month
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If strType = "Purchase Order" Then
-
'Check to see if the Year Exists
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
-
If gfx_FolderExists(strFilePath) = False Then
-
'Creates the Year Folder
-
MkDir strFilePath
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
-
-
strFilePath = strFilePath & "\" & strMonth
-
-
'Check to see if the Month Exists
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
-
If gfx_FolderExists(strFilePath) = False Then
-
'Creates the Month Folder
-
MkDir strFilePath
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
-
-
ElseIf strType = "Sale Order" Then
-
'Check to see if the Year Exists
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
-
If gfx_FolderExists(strFilePath) = False Then
-
'Creates the Year Folder
-
MkDir strFilePath
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
-
-
strFilePath = strFilePath & "\" & strMonth
-
-
'Check to see if the Year Exists
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
-
If gfx_FolderExists(strFilePath) = False Then
-
'Creates the Month Folder
-
MkDir strFilePath
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
-
'Verify both the DynaPDF.DLL and the strStorage.DLL are available
-
Dim blnFindDLLs As Boolean
-
blnFindDLLs = gfx_LoadLibrary()
-
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If blnFindDLLs = False Then
-
'Cannot find DynaPDF.dll or StrStorage.dll file
-
Exit Function
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
-
'Inititalize the string buffer for the File Path
-
Dim strPath As String
-
strPath = Space(mConst_Pathlen)
-
-
-
'Save the ReportName to a module level variable
-
m_strReportName = strReportName
-
-
-
'Clears any existing Temp SnapShot file
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If Len(mConst_UncompressedSnapFile & vbNullString) > 0 Then
-
Kill mConst_UncompressedSnapFile
-
mConst_UncompressedSnapFile = ""
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
-
'If we have been passed the name of a Snapshot file then skip the Snapshot creation process below
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If Len(strSnapshotName & vbNullString) = 0 Then
-
-
'Ensures a ReportName has been passed
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
-
If Nz(strReportName, 0) = 0 Then
-
MsgBox " No valid Report Name has been found." & vbCrLf & "Contact your System Admin.", vbOKOnly + vbCritical, gName
-
gfx_ConvertReportToPDF = False
-
Exit Function
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
-
-
'Get the Systems Temp path & Returns Length of path(num characters in path)
-
Dim lngRet As Long
-
lngRet = GetTempPath(mConst_Pathlen, strPath)
-
-
'Chop off NULLS and trailing "\"
-
strPath = Left(strPath, lngRet) & Chr(0)
-
-
'Specify a Unique File Name
-
Dim strPathandFileName As String
-
strPathandFileName = DLookup("[txtLocation]", "sysDirectories", "[txtDescription]='File Storage Directory'") & "\SP Connect.snp" 'gfx_GetUniqueFilename(strPath, "SP" & Chr(0), "snp")
-
-
'Export the selected Report to SnapShot format
-
DoCmd.OutputTo acOutputReport, strReportName, "SnapshotFormat(*.snp)", strPathandFileName
-
-
'Make sure the process has time to complete
-
DoEvents
-
-
Else: ' 1
-
strPathandFileName = strSnapshotName
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
Dim strOutputFile As String
-
-
-
'Decompress into same filename but change type to ".tmp"
-
Dim sPath As String * 512
-
lngRet = GetTempPath(512, sPath)
-
-
Dim strEMFUncompressed As String
-
strEMFUncompressed = gfx_GetUniqueFilename(sPath, "SP", "tmp")
-
-
lngRet = SetupDecompressOrCopyFile(strPathandFileName, strEMFUncompressed, 0&)
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If lngRet <> 0 Then
-
MsgBox "Cannot Decompress the SnapShot File" & vbCrLf & "Contact your System Admin.", vbOKOnly + vbCritical, gName
-
gfx_ConvertReportToPDF = False
-
Exit Function
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
-
'Set the uncompressed SnapShot file name variable
-
mConst_UncompressedSnapFile = strEMFUncompressed
-
-
-
'Cleanup the Temp SnapShot File if the Snapshot file name was not passed as the optional parameter
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If Len(strSnapshotName & vbNullString) = 0 Then
-
Kill strPathandFileName
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
-
'Name output file the same as the input file name (w/ file extension .PDF) or show the File Save Dialog
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If Len(strSnapshotName & vbNullString) = 0 Then
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
-
If blnShowSaveFileDialog = False Then
-
'Decompress into same filename but change type to ".tmp"
-
-
'First see if an output PDF file name was passed
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 3
-
If Len(strOutputPDFname & vbNullString) = 0 Then
-
strOutputFile = Mid(strPathandFileName, 1, Len(strPathandFileName) - 3)
-
strOutputFile = strOutputFile & "PDF"
-
-
Else: ' 3
-
strOutputFile = strOutputPDFname & "PDF"
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 3
-
-
'This is the name of and file path of the output PDF
-
strOutputFile = strFilePath & "\" & strOutputPDFname & ".PDF"
-
-
Else: ' 2
-
'Call File Save Dialog
-
strOutputFile = gfx_fFileDialog()
-
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 3
-
If Len(strOutputFile & vbNullString) = 0 Then
-
Exit Function
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 3
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
-
-
Else:
-
'This is used if you specify the snapshot name instead of just passing the report name.
-
-
'This is the name of and file path of the output PDF (changed - BD - Refer to original if trying to pass a snapshot name)
-
strOutputFile = strFilePath & "\" & strOutputPDFname & ".PDF"
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
-
'Call the ConvertUncompressedShapshot function in the StrStorage DLL (Note the Compression and Password params are not hooked up yet)
-
'NOTE: This is the point where the PDF is actually created
-
blnFindDLLs = ConvertUncompressedSnapshot(mConst_UncompressedSnapFile, strOutputFile, lngCompressionLevel, lngPDFNoFontEmbedding, lngPDFUnicodeFlags)
-
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If blnFindDLLs = False Then
-
MsgBox "The SnapShot File is damaged." & vbCrLf & "Contact your System Admin.", vbOKOnly + vbCritical, gName
-
gfx_ConvertReportToPDF = False
-
Exit Function
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
-
'Open new PDF in default PDF viewer
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If blnStartPDFViewer = True Then
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
-
If MsgBox("Your PDF File has been created." & vbCrLf & " Would you like to preview?", vbYesNo + vbQuestion, gName) = vbYes Then
-
ShellExecuteA Application.hWndAccessApp, "open", strOutputFile, vbNullString, vbNullString, 1
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
'Success
-
gfx_ConvertReportToPDF = True
-
-
-
Exit_Err_ErrorHandler:
-
On Error Resume Next
-
-
'Kill any existing Temp SnapShot file
-
Kill mConst_UncompressedSnapFile
-
mConst_UncompressedSnapFile = ""
-
-
'Frees the Libraries
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If hLibStrStorage <> 0 Then
-
hLibStrStorage = FreeLibrary(hLibStrStorage)
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If hLibDynaPDF <> 0 Then
-
hLibDynaPDF = FreeLibrary(hLibDynaPDF)
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
Exit Function
-
-
Err_ErrorHandler:
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
If MsgBox("You have encountered an error. Would you like to Email the issue to the Database Administrator?", vbYesNo + vbCritical, gName & " [" & strSubCallingID & "]") = vbYes Then
-
gfxErrorMessage Err.Number, Err.Description, "n/a", strSubCallingID, Screen.ActiveControl.Name
-
Else:
-
MsgBox Err.Description & vbCrLf & "Tell your system administrator you Received Error Code: " & Err.Number, vbCritical, gName & " [" & strSubCallingID & "]"
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
mConst_UncompressedSnapFile = ""
-
gfx_ConvertReportToPDF = False
-
-
Resume Exit_Err_ErrorHandler
-
-
End Function
-
-
-
Private Function gfx_LoadLibrary() As Boolean
-
On Error Resume Next
-
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
' Ensures that the Library DLL has been loaded OR calls the library to be loaded
-
' Step 1 of
-
' NOTE: If you are going to process many reports at once then to improve performance you should only call gfx_LoadLibrary once.
-
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
Dim strSubCallingID As String
-
strSubCallingID = "modPDFCode : gfx_LoadLibrary"
-
-
-
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
'PRELIMINARY:
-
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-
'Resets the Variable
-
gfx_LoadLibrary = False
-
-
-
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
'Step 1: Load the DynaPDF.DLL File
-
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-
'If we aready loaded hLibDynaPDF (<>0) then free the library
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If hLibDynaPDF <> 0 Then
-
hLibDynaPDF = FreeLibrary(hLibDynaPDF)
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
'First, try to load the DLL, assuming it is in the same folder as this MDB.
-
'hLibDynaPDF = LoadLibrary(gfx_CurrentDBDir() & "\Reference\DynaPDF.dll")
-
'9*9*9*9*9*9*9
-
Dim str As String
-
str = "C:\SP Connect\System\Reference\DynaPDF.dll"
-
-
hLibDynaPDF = LoadLibrary(str)
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If hLibDynaPDF = 0 Then
-
'Second, (if hLibDynaPDF still = 0) try to load the DLL From Window System folder
-
hLibDynaPDF = LoadLibrary("C:\SP Connect\System\Reference\DynaPDF.dll")
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If hLibDynaPDF = 0 Then
-
'Third, (if hLibDynaPDF still = 0) try to load the DLL From Window System folder
-
hLibDynaPDF = LoadLibrary("DynaPDF.dll")
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If hLibDynaPDF = 0 Then
-
'Forth, (if hLibDynaPDF still = 0) try to load the DLL From Access Folder
-
hLibDynaPDF = LoadLibrary("C:\Program Files (x86)\Microsoft Office\Office14\DynaPDF.dll")
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
'Cancels the function if the DLL file cannot be found
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If hLibDynaPDF = 0 Then
-
MsgBox " The DynaPDF.dll file is Missing." & vbCrLf & "Please contact your Database Admin.", vbOKOnly + vbCritical, gName
-
gfx_LoadLibrary = False
-
Exit Function
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
-
-
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
'Step 2: Load the StrStorage.DLL File
-
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-
'If we aready loaded hLibStrStorage (<>0) then free the library
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If hLibStrStorage <> 0 Then
-
hLibStrStorage = FreeLibrary(hLibStrStorage)
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
'First, try to load the DLL, assuming it is in the same folder as this MDB.
-
hLibStrStorage = LoadLibrary(gfx_CurrentDBDir() & "\Reference\StrStorage.dll")
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If hLibStrStorage = 0 Then
-
'Second, (if hLibStrStorage still = 0) try to load the DLL From Window System folder
-
hLibStrStorage = LoadLibrary("StrStorage.dll")
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
'Cancels the function if the DLL file cannot be found
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If hLibStrStorage = 0 Then
-
MsgBox " The StrStorage.dll file is Missing." & vbCrLf & "Please contact your Database Admin.", vbOKOnly + vbCritical, gName
-
gfx_LoadLibrary = False
-
Exit Function
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
-
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
'Step 3: Set the Variable to Successful
-
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-
'Resets the Variable
-
gfx_LoadLibrary = True
-
-
-
End Function
-
-
-
Private Function gfx_GetUniqueFilename(Optional strFilePath As String = "", Optional strPrefix As String = "", Optional strUseExtension As String = "") As String
-
On Error GoTo Err_ErrorHandler
-
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
' Assigns a Unique File Name
-
' Originally Posted by Terry Kreft <terry.kreft@mps.co.uk>
-
' Note: Input strings must be NULL terminated; here it is done by the calling function.
-
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
Dim strSubCallingID As String
-
strSubCallingID = "gfx_GetUniqueFilename"
-
-
-
Dim lngUniqueID As Long
-
lngUniqueID = 0
-
-
Dim strTempFileName As String
-
Dim lngRet As Long
-
-
'If No file Path has been specified, the default is the current directory
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If strFilePath = "" Then
-
strFilePath = CurDir
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
strTempFileName = String(mCosnt_MaxPath, 0)
-
lngRet = GetTempFileName(strFilePath, strPrefix, lngUniqueID, strTempFileName)
-
-
strTempFileName = Left(strTempFileName, InStr(strTempFileName, Chr(0)) - 1)
-
-
Call Kill(strTempFileName)
-
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If Len(strUseExtension) > 0 Then
-
strTempFileName = Left(strTempFileName, Len(strTempFileName) - 3) & strUseExtension
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
gfx_GetUniqueFilename = strTempFileName
-
-
Exit_Err_ErrorHandler:
-
Exit Function
-
-
Err_ErrorHandler:
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
If MsgBox("You have encountered an error. Would you like to Email the issue to the Database Administrator?", vbYesNo + vbCritical, gName & " [" & strSubCallingID & "]") = vbYes Then
-
gfxErrorMessage Err.Number, Err.Description, "n/a", strSubCallingID, Screen.ActiveControl.Name
-
Else:
-
MsgBox Err.Description & vbCrLf & "Tell your system administrator you Received Error Code: " & Err.Number, vbCritical, gName & " [" & strSubCallingID & "]"
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
Resume Exit_Err_ErrorHandler
-
-
End Function
-
-
-
Private Function gfx_fFileDialog() As String
-
On Error GoTo Err_ErrorHandler
-
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
' Calls the API File Save Dialog Window; Returns full path to new File
-
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
Dim strSubCallingID As String
-
strSubCallingID = "gfx_fFileDialog"
-
-
-
'Call the File Common Dialog Window
-
Dim clsDialog As Object
-
Dim strTemp As String
-
Dim strFname As String
-
-
Set clsDialog = New clsCommonDialog
-
-
clsDialog.Filter = "PDF (*.PDF)" & Chr$(0) & "*.PDF" & Chr$(0)
-
clsDialog.hDC = 0
-
clsDialog.MaxFileSize = 256
-
clsDialog.Max = 256
-
clsDialog.FileTitle = vbNullString
-
clsDialog.DialogTitle = gName & ": Please Select a path and Enter a Name for the PDF File"
-
clsDialog.InitDir = vbNullString
-
clsDialog.DefaultExt = vbNullString
-
-
'Display the File Dialog
-
clsDialog.ShowSave
-
-
'See if user clicked Cancel or even selected the very same file already selected
-
strFname = clsDialog.FileName
-
-
'Return File Path and Name
-
gfx_fFileDialog = strFname
-
-
Exit_Err_ErrorHandler:
-
Exit Function
-
-
Err_ErrorHandler:
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
If MsgBox("You have encountered an error. Would you like to Email the issue to the Database Administrator?", vbYesNo + vbCritical, gName & " [" & strSubCallingID & "]") = vbYes Then
-
gfxErrorMessage Err.Number, Err.Description, "n/a", strSubCallingID, Screen.ActiveControl.Name
-
Else:
-
MsgBox Err.Description & vbCrLf & "Tell your system administrator you Received Error Code: " & Err.Number, vbCritical, gName & " [" & strSubCallingID & "]"
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
Resume Exit_Err_ErrorHandler
-
-
End Function
-
-
-
Public Function gfx_fFileDialogSnapshot() As String
-
On Error GoTo Err_ErrorHandler
-
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
' Calls the API File Open Dialog Window
-
' Returns full path to existing Snapshot File
-
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
Dim strSubCallingID As String
-
strSubCallingID = "gfx_fFileDialogSnapshot"
-
-
-
'Call the File Common Dialog Window
-
Dim clsDialog As Object
-
Dim strTemp As String
-
Dim strFname As String
-
-
Set clsDialog = New clsCommonDialog
-
-
clsDialog.Filter = "SNAPSHOT (*.SNP)" & Chr$(0) & "*.SNP" & Chr$(0)
-
clsDialog.hDC = 0
-
clsDialog.MaxFileSize = 256
-
clsDialog.Max = 256
-
clsDialog.FileTitle = vbNullString
-
clsDialog.DialogTitle = "Please Select a Snapshot File"
-
clsDialog.InitDir = vbNullString
-
clsDialog.DefaultExt = vbNullString
-
-
'Display the File Dialog
-
clsDialog.ShowOpen
-
-
'See if user clicked Cancel or even selected the very same file already selected
-
strFname = clsDialog.FileName
-
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If Len(strFname & vbNullString) = 0 Then
-
'Do nothing. Add your desired error logic here.
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
'Return File Path and Name
-
gfx_fFileDialogSnapshot = strFname
-
-
Exit_Err_ErrorHandler:
-
Err.Clear
-
Set clsDialog = Nothing
-
Exit Function
-
-
Err_ErrorHandler:
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
If MsgBox("You have encountered an error. Would you like to Email the issue to the Database Administrator?", vbYesNo + vbCritical, gName & " [" & strSubCallingID & "]") = vbYes Then
-
gfxErrorMessage Err.Number, Err.Description, "n/a", strSubCallingID, Screen.ActiveControl.Name
-
Else:
-
MsgBox Err.Description & vbCrLf & "Tell your system administrator you Received Error Code: " & Err.Number, vbCritical, gName & " [" & strSubCallingID & "]"
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
gfx_fFileDialogSnapshot = ""
-
-
Resume Exit_Err_ErrorHandler
-
-
End Function
-
-
-
Public Function gfx_fFileDialogSavePDFname() As String
-
On Error GoTo Err_ErrorHandler
-
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
' Calls the API File Open Dialog Window
-
' Returns full path to existing Snapshot File
-
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
Dim strSubCallingID As String
-
strSubCallingID = "gfx_fFileDialogSavePDFname"
-
-
-
'Call the File Common Dialog Window
-
Dim clsDialog As Object
-
Dim strTemp As String
-
Dim strFname As String
-
-
Set clsDialog = New clsCommonDialog
-
-
clsDialog.Filter = "PDF (*.PDF)" & Chr$(0) & "*.PDF" & Chr$(0)
-
clsDialog.hDC = 0
-
clsDialog.MaxFileSize = 256
-
clsDialog.Max = 256
-
clsDialog.FileTitle = vbNullString
-
clsDialog.DialogTitle = "Please Select a name for the PDF File"
-
clsDialog.InitDir = vbNullString
-
clsDialog.DefaultExt = vbNullString
-
-
-
'Display the File Dialog
-
clsDialog.ShowOpen
-
-
'See if user clicked Cancel or even selected the very same file already selected
-
strFname = clsDialog.FileName
-
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
If Len(strFname & vbNullString) = 0 Then
-
'Do nothing. Add your desired error logic here.
-
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
-
-
'Return File Path and Name
-
gfx_fFileDialogSavePDFname = strFname
-
-
Exit_Err_ErrorHandler:
-
Err.Clear
-
Set clsDialog = Nothing
-
Exit Function
-
-
Err_ErrorHandler:
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
If MsgBox("You have encountered an error. Would you like to Email the issue to the Database Administrator?", vbYesNo + vbCritical, gName & " [" & strSubCallingID & "]") = vbYes Then
-
gfxErrorMessage Err.Number, Err.Description, "n/a", strSubCallingID, Screen.ActiveControl.Name
-
Else:
-
MsgBox Err.Description & vbCrLf & "Tell your system administrator you Received Error Code: " & Err.Number, vbCritical, gName & " [" & strSubCallingID & "]"
-
End If
-
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-
gfx_fFileDialogSavePDFname = ""
-
-
Resume Exit_Err_ErrorHandler
-
-
End Function
-
zmbd 5,501
Expert Mod 4TB
OK,
In ACC2010, you will not need to use this code.
You can send the report using: DoCmd.SendObject Method (Access)
The message body text is limited to 255charators
the attachments are limited to one
AND if you get stuck with this... we're here to help!
you can also use application automation with Outlook or CDO for more complicated emails.
To place a copy of the report on the pc/lan - DoCmd.OutputTo acOutputReport, "rptMyReport", acFormatPDF, "C:\Reports\MyReport.pdf"
Now that you are using ACC2007/2010: I can not stress enough the fact that you need to ditch this outdated, unsupported code
At Some point, the OS is going to terminate this outdated DLL, and in fact, with 64Bit OS installs becoming the norm, it will be sooner rather than latter!
I've been warned by my IT department to start looking at my DB applications for 64Bit-Office install compatibilities too!
IT IS COMING>> THE 64BIT MONSTER>>> OH NO - THERE-GOES-TOKIO>>>>GOGOG-GODZILLA (I love those old Godzilla movies... Mothera... opps, dated myself).
Thanks, zmbd.
I'll give this a try - I can't recall why I shied away from this to begin with but I'm glad that I've got some direction on.
Thanks again.
Gunner
Sign in to post your reply or Sign up for a free account.
Similar topics
by: Siegfried Heintze |
last post by:
I have some C functions I need to expose as XML web services. My original
plan was to deply an XML Web service in C# and use P/Invoke to call my C
functions. This is not working because the web...
|
by: one2001boy |
last post by:
Hello,
I can use call a function with any arugment from LoadLibrary(),
but not a function with argument of "FILE*.
For example, I can build a .DLL dynamically loaded library with
option /DDD...
|
by: ATS |
last post by:
HOWTO Implement LoadLibrary\GetProcAdrress\FreeLibrary in C#
Please help,
I want to fully implement LoadLibrary\GetProcAdrress\FreeLibrary in C#, and
be able to call functions that I use...
|
by: ATS |
last post by:
HOWTO Implement LoadLibrary, GetProcAdress, and FreeLibrary.
Below is code that I want to be able to use simple
LoadLibrary\GetProcAddress\FreeLibrary technqiues on. I've used the code that
was...
|
by: tomrmgc |
last post by:
I have a dll that was working in VC6, but isn't loading after being built in
VC71. LoadLibrary() returns null and the error code (from GetLastError()) is
-2147483645 "One or more arguments are...
|
by: Michael Tissington |
last post by:
I'm using LoadLibrary to import a DLL in a asp.net application.
The dll was written in c++ and is located in the bin folder
I have been testing the website on my development machine and our...
|
by: Siegfried Heintze |
last post by:
I have some C functions I need to expose as XML web services. My original
plan was to deply an XML Web service in C# or VB and use P/Invoke to call my
C functions. This is not working because the...
|
by: MLH |
last post by:
Am using StrStorage.dll & DynaPDF.dll
(Lebans tools) for creating PDF's. At most
sites, there are no glitches. However, I
have a problem at one site.
Just so happens its a site on which I...
|
by: Benny the Guard |
last post by:
Working in some managed code that is trying to load one of my DLLs. This seems to work fine in release builds outside the context of my version amangement system. But inside it fails witha code of...
|
by: Peter Morris |
last post by:
I have a class named DynamicLinkLibrary which does this:
private static extern IntPtr LoadLibrary(string fileName);
protected virtual void Load(string fileName)
{
EnsureNotDisposed();
if...
|
by: ryjfgjl |
last post by:
ExcelToDatabase: batch import excel into database automatically...
|
by: isladogs |
last post by:
The next Access Europe meeting will be on Wednesday 6 Mar 2024 starting at 18:00 UK time (6PM UTC) and finishing at about 19:15 (7.15PM).
In this month's session, we are pleased to welcome back...
|
by: isladogs |
last post by:
The next Access Europe meeting will be on Wednesday 6 Mar 2024 starting at 18:00 UK time (6PM UTC) and finishing at about 19:15 (7.15PM).
In this month's session, we are pleased to welcome back...
|
by: jfyes |
last post by:
As a hardware engineer, after seeing that CEIWEI recently released a new tool for Modbus RTU Over TCP/UDP filtering and monitoring, I actively went to its official website to take a look. It turned...
|
by: ArrayDB |
last post by:
The error message I've encountered is; ERROR:root:Error generating model response: exception: access violation writing 0x0000000000005140, which seems to be indicative of an access violation...
|
by: CloudSolutions |
last post by:
Introduction:
For many beginners and individual users, requiring a credit card and email registration may pose a barrier when starting to use cloud servers. However, some cloud server providers now...
|
by: Shællîpôpï 09 |
last post by:
If u are using a keypad phone, how do u turn on JavaScript, to access features like WhatsApp, Facebook, Instagram....
|
by: af34tf |
last post by:
Hi Guys, I have a domain whose name is BytesLimited.com, and I want to sell it. Does anyone know about platforms that allow me to list my domain in auction for free. Thank you
|
by: isladogs |
last post by:
The next Access Europe User Group meeting will be on Wednesday 3 Apr 2024 starting at 18:00 UK time (6PM UTC+1) and finishing by 19:30 (7.30PM).
In this session, we are pleased to welcome former...
| |