By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,477 Members | 1,641 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,477 IT Pros & Developers. It's quick & easy.

DynaPDF LoadLibrary() Not Working

100+
P: 107
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
Dec 8 '13 #1
Share this Question
Share on Google+
7 Replies


100+
P: 107
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.
Dec 8 '13 #2

zmbd
Expert Mod 5K+
P: 5,287
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.
Dec 8 '13 #3

100+
P: 107
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
Dec 8 '13 #4

zmbd
Expert Mod 5K+
P: 5,287
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
Dec 8 '13 #5

100+
P: 107
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


Expand|Select|Wrap|Line Numbers
  1. Option Compare Database
  2. Option Explicit
  3.  
  4.     #Const ConDebug = 0    ' Set to 1 to force loading of DEBUG StrStorage.DLL
  5.  
  6.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  7.     #If (ConDebug = 1) Then
  8.  
  9.         Public Declare Function ConvertUncompressedSnapshot Lib "C:\VisualCsource\Debug\StrStorage.dll" (ByVal UnCompressedSnapShotName As String, _
  10.                                 ByVal OutputPDFname As String, Optional ByVal CompressionLevel As Long = 0, Optional ByVal PasswordOpen As String = "", _
  11.                                 Optional ByVal PasswordOwner As String = "", Optional ByVal PasswordRestrictions As Long = 0, _
  12.                                 Optional ByVal PDFNoFontEmbedding As Long = 0, Optional ByVal PDFUnicodeFlags As Long = 0) As Boolean
  13.  
  14.  
  15.         Public Declare Function DrawTableWindow Lib "C:\VisualCsource\Debug\StrStorage.dll" (ByVal TableName As String, ByVal Fields As String, _
  16.                                 ByVal NumFields As Long, ByVal Xpos As Double, ByVal Ypos As Double, ByVal Width As Double, ByVal Height As Double) As Long
  17.  
  18.  
  19.         Public Declare Function DrawLine Lib "C:\VisualCsource\Debug\StrStorage.dll" (ByVal Width As Double, ByVal Width1 As Double, ByVal Xpos As Double, _
  20.                                 ByVal Ypos As Double, ByVal Xpos1 As Double, ByVal Ypos1 As Double, ByVal Attrib As Long) As Long
  21.  
  22.  
  23.         Public Declare Function BeginPDF Lib "C:\VisualCsource\Debug\StrStorage.dll" (ByVal PDFfilename As String, ByVal PageWidth As Long, _
  24.                                 ByVal PageHeight As Long) As Long
  25.  
  26.  
  27.         Public Declare Function EndPDF Lib "C:\VisualCsource\Debug\StrStorage.dll" () As Long
  28.  
  29.  
  30.         Public Declare Function MergePDFDocuments Lib "C:\VisualCsource\Debug\StrStorage.dll" (ByVal PDFMaster As String, ByVal PDFChild As String) As Boolean
  31.  
  32.  
  33.     #Else
  34.  
  35.  
  36.         Public Declare Function ConvertUncompressedSnapshot Lib "StrStorage.dll" (ByVal UnCompressedSnapShotName As String, ByVal OutputPDFname As String, _
  37.                                 Optional ByVal CompressionLevel As Long = 0, Optional ByVal PasswordOpen As String = "", Optional ByVal PasswordOwner As String = "", _
  38.                                 Optional ByVal PasswordRestrictions As Long = 0, Optional ByVal PDFNoFontEmbedding As Long = 0, _
  39.                                 Optional ByVal PDFUnicodeFlags As Long = 0) As Boolean
  40.  
  41.  
  42.         Public Declare Function DrawTableWindow Lib "StrStorage.dll" (ByVal TableName As String, ByVal Fields As String, ByVal NumFields As Long, _
  43.                                 ByVal Xpos As Double, ByVal Ypos As Double, ByVal Width As Double, ByVal Height As Double) As Long
  44.  
  45.  
  46.         Public Declare Function DrawLine Lib "StrStorage.dll" (ByVal Width As Double, ByVal Width1 As Double, ByVal Xpos As Double, ByVal Ypos As Double, _
  47.                                 ByVal Xpos1 As Double, ByVal Ypos1 As Double, ByVal Attrib As Long) As Long
  48.  
  49.  
  50.         Public Declare Function BeginPDF Lib "StrStorage.dll" (ByVal PDFfilename As String, ByVal PageWidth As Long, ByVal PageHeight As Long) As Long
  51.  
  52.  
  53.         Public Declare Function EndPDF Lib "StrStorage.dll" () As Long
  54.  
  55.  
  56.         Public Declare Function MergePDFDocuments Lib "StrStorage.dll" (ByVal PDFMaster As String, ByVal PDFChild As String) As Boolean
  57.  
  58.  
  59.     #End If
  60.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  61.  
  62.  
  63.     Private Declare Function ShellExecuteA Lib "shell32.dll" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
  64.                                 ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
  65.  
  66.  
  67.     Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
  68.  
  69.  
  70.     Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
  71.  
  72.  
  73.     Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
  74.  
  75.  
  76.     Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, _
  77.                                 ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
  78.  
  79.  
  80.     Private Declare Function SetupDecompressOrCopyFile Lib "setupAPI" Alias "SetupDecompressOrCopyFileA" (ByVal SourceFileName As String, _
  81.                                 ByVal TargetFileName As String, ByVal CompressionType As Integer) As Long
  82.  
  83.  
  84.     Private Declare Function SetupGetFileCompressionInfo Lib "setupAPI" Alias "SetupGetFileCompressionInfoA" (ByVal SourceFileName As String, _
  85.                                 TargetFileName As String, SourceFileSize As Long, DestinationFileSize As Long, CompressionType As Integer) As Long
  86.  
  87.  
  88.  
  89.    'Compression types
  90.     Private Const FILE_COMPRESSION_NONE = 0
  91.     Private Const FILE_COMPRESSION_WINLZA = 1
  92.     Private Const FILE_COMPRESSION_MSZIP = 2
  93.  
  94.     Private Const mConst_Pathlen = 256
  95.     Private Const mCosnt_MaxPath = 256
  96.  
  97.     'Enum TKeyLen
  98.        Public Const kl40bit = 0    '  40 bit RC4 encryption (Acrobat 3 or higher)
  99.        Public Const kl128bit = 1 ' 128 bit RC4 encryption (Acrobat 5 or higher)
  100.        Public Const kl128bitEx = 2 ' 128 bit RC4 encryption (Acrobat 6 or higher)
  101.     'End Enum
  102.  
  103.     'Enum TRestrictions
  104.       Public Const rsDenyNothing = 0
  105.       Public Const rsDenyAll = 3900
  106.       Public Const rsPrint = 4
  107.       Public Const rsModify = 8
  108.       Public Const rsCopyObj = 16
  109.       Public Const rsAddObj = 32
  110.       ' 128 bit encryption only -> these values are ignored if 40 bit encryption is used
  111.       Public Const rsFillInFormFields = 256
  112.       Public Const rsExtractObj = 512
  113.       Public Const rsAssemble = 1024
  114.       Public Const rsPrintHighRes = 2048
  115.       Public Const rsExlMetadata = 4096      ' PDF 1.5 -> can be used with kl128bitEx only
  116.     'End Enum
  117.  
  118.  
  119.     Public Type POINTAPI
  120.        X As Long
  121.        Y As Long
  122.     End Type
  123.  
  124.     Public Type RECTL
  125.        Left As Long
  126.        Top As Long
  127.        Right As Long
  128.        Bottom As Long
  129.     End Type
  130.  
  131.     Public Const AAAlength = 12
  132.     Public Const FFFlength = 8
  133.     Public Const Padding = 12
  134.     Public Const NameLengthMax = 128
  135.     ' 64 Char MAX for a DAO Table Name * 2 = Unicode
  136.  
  137.     Public Type RelBlob
  138.         Sig As Long
  139.         AAAs(1 To AAAlength) As Byte
  140.         RelWinX1  As Long
  141.         RelWinY1 As Long
  142.         RelWinX2  As Long
  143.         RelWinY2 As Long
  144.         Blank As Long
  145.         FFFs(1 To FFFlength) As Byte
  146.         ClientRectX As Long
  147.         ClientRectY As Long
  148.         'Pad(1 To Padding) As Byte
  149.         ' These next 2 long values represent the Horiz and Vert ScrollBar positions(if any).
  150.         ' These values must be added to the window coordinates stored in this Blob.
  151.         ScrollBarYoffset As Long
  152.         ScrollBarXoffset As Long
  153.         Pad1 As Long
  154.         NumWindows As Long
  155.     End Type
  156.  
  157.     Public Type RelWindow
  158.         RelWinX1  As Long
  159.         RelWinY1 As Long
  160.         RelWinX2  As Long
  161.         RelWinY2 As Long
  162.         Junk As Long
  163.         WinName As String * NameLengthMax
  164.         Junk1 As Long
  165.         WinNameMaster As String * NameLengthMax
  166.         'Pad(1 To Padding) As Byte
  167.         Junk2 As Long
  168.     End Type
  169.  
  170.     Public Type RelWindowMin
  171.         RelWinX1  As Long
  172.         RelWinY1 As Long
  173.         RelWinX2  As Long
  174.         RelWinY2 As Long
  175.         Column As Long
  176.         WinName As String
  177.     End Type
  178.  
  179.     Public Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
  180.  
  181.     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
  182.  
  183.     Public Declare Function apiGetWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
  184.  
  185.     Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECTL) As Long
  186.  
  187.     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, _
  188.                                 ByVal cy As Long, ByVal wFlags As Long) As Long
  189.  
  190.     Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
  191.  
  192.     Public Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  193.  
  194.    'Create an Information Context
  195.     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
  196.  
  197.     Private Declare Function apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hDC As Long, ByVal nIndex As Long) As Long
  198.  
  199.     Private Declare Function apiDeleteDC Lib "gdi32" Alias "DeleteDC" (ByVal hDC As Long) As Long
  200.  
  201.  
  202.    'SetWindowPos() Constants
  203.     Public Const SWP_SHOWWINDOW = &H40
  204.  
  205.    'GetWindow() Constants
  206.     Public Const GW_HWNDNEXT = 2
  207.     Public Const GW_CHILD = 5
  208.  
  209.    'Device Parameters for GetDeviceCaps()
  210.     Private Const LOGPIXELSX = 88        '  Logical pixels/inch in X
  211.     Private Const LOGPIXELSY = 90        '  Logical pixels/inch in Y
  212.  
  213.  
  214.    '***********************************************
  215.    'Font, DC and TextWidth stuff
  216.  
  217.     Private Type RECT
  218.             Left As Long
  219.             Top As Long
  220.             Right As Long
  221.             Bottom As Long
  222.     End Type
  223.  
  224.     Private Const LF_FACESIZE = 32
  225.  
  226.     Private Type LOGFONT
  227.             lfHeight As Long
  228.             lfWidth As Long
  229.             lfEscapement As Long
  230.             lfOrientation As Long
  231.             lfWeight As Long
  232.             lfItalic As Byte
  233.             lfUnderline As Byte
  234.             lfStrikeOut As Byte
  235.             lfCharSet As Byte
  236.             lfOutPrecision As Byte
  237.             lfClipPrecision As Byte
  238.             lfQuality As Byte
  239.             lfPitchAndFamily As Byte
  240.             lfFaceName As String * LF_FACESIZE
  241.     End Type
  242.  
  243.     Private Type TEXTMETRIC
  244.             tmHeight As Long
  245.             tmAscent As Long
  246.             tmDescent As Long
  247.             tmInternalLeading As Long
  248.             tmExternalLeading As Long
  249.             tmAveCharWidth As Long
  250.             tmMaxCharWidth As Long
  251.             tmWeight As Long
  252.             tmOverhang As Long
  253.             tmDigitizedAspectX As Long
  254.             tmDigitizedAspectY As Long
  255.             tmFirstChar As Byte
  256.             tmLastChar As Byte
  257.             tmDefaultChar As Byte
  258.             tmBreakChar As Byte
  259.             tmItalic As Byte
  260.             tmUnderlined As Byte
  261.             tmStruckOut As Byte
  262.             tmPitchAndFamily As Byte
  263.             tmCharSet As Byte
  264.     End Type
  265.  
  266.     Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hDC As Long, lpMetrics As TEXTMETRIC) As Long
  267.  
  268.     Private Declare Function apiCreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
  269.  
  270.     Private Declare Function apiSelectObject Lib "gdi32" Alias "SelectObject" (ByVal hDC As Long, ByVal hObject As Long) As Long
  271.  
  272.     Private Declare Function apiDeleteObject Lib "gdi32" Alias "DeleteObject" (ByVal hObject As Long) As Long
  273.  
  274.     Private Declare Function apiMulDiv Lib "kernel32" Alias "MulDiv" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
  275.  
  276.     Private Declare Function apiGetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Long) As Long
  277.  
  278.     Private Declare Function apiReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Long, ByVal hDC As Long) As Long
  279.  
  280.     Private Declare Function apiDrawText Lib "user32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, _
  281.                         ByVal wFormat As Long) As Long
  282.  
  283.     Private Declare Function CreateDCbyNum Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As Long, _
  284.                         ByVal lpInitData As Long) As Long
  285.  
  286.     Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, _
  287.                         ByVal lpReturnedString As String, ByVal nSize As Long) As Long
  288.  
  289.  
  290.    'CONSTANTS
  291.     Private Const TWIPSPERINCH = 1440
  292.  
  293.    'DrawText() Format Flags
  294.     Private Const DT_TOP = &H0
  295.     Private Const DT_LEFT = &H0
  296.     Private Const DT_CALCRECT = &H400
  297.     Private Const DT_WORDBREAK = &H10
  298.     Private Const DT_EXTERNALLEADING = &H200
  299.     Private Const DT_EDITCONTROL = &H2000&
  300.     Private Const DT_NOCLIP = &H100
  301.  
  302.    'Font stuff
  303.     Private Const OUT_DEFAULT_PRECIS = 0
  304.     Private Const OUT_STRING_PRECIS = 1
  305.     Private Const OUT_CHARACTER_PRECIS = 2
  306.     Private Const OUT_STROKE_PRECIS = 3
  307.     Private Const OUT_TT_PRECIS = 4
  308.     Private Const OUT_DEVICE_PRECIS = 5
  309.     Private Const OUT_RASTER_PRECIS = 6
  310.     Private Const OUT_TT_ONLY_PRECIS = 7
  311.     Private Const OUT_OUTLINE_PRECIS = 8
  312.  
  313.     Private Const CLIP_DEFAULT_PRECIS = 0
  314.     Private Const CLIP_CHARACTER_PRECIS = 1
  315.     Private Const CLIP_STROKE_PRECIS = 2
  316.     Private Const CLIP_MASK = &HF
  317.     Private Const CLIP_LH_ANGLES = 16
  318.     Private Const CLIP_TT_ALWAYS = 32
  319.     Private Const CLIP_EMBEDDED = 128
  320.  
  321.     Private Const DEFAULT_QUALITY = 0
  322.     Private Const DRAFT_QUALITY = 1
  323.     Private Const PROOF_QUALITY = 2
  324.  
  325.     Private Const DEFAULT_PITCH = 0
  326.     Private Const FIXED_PITCH = 1
  327.     Private Const VARIABLE_PITCH = 2
  328.  
  329.     Private Const ANSI_CHARSET = 0
  330.     Private Const DEFAULT_CHARSET = 1
  331.     Private Const SYMBOL_CHARSET = 2
  332.     Private Const SHIFTJIS_CHARSET = 128
  333.     Private Const HANGEUL_CHARSET = 129
  334.     Private Const CHINESEBIG5_CHARSET = 136
  335.     Private Const OEM_CHARSET = 255
  336.  
  337.     ' ***********************************************
  338.  
  339. 'Allow user to set FileName instead of using API Temp Filename or popping File Dialog Window
  340.     Private mSaveFileName As String
  341.  
  342. 'Full path and name of uncompressed SnapShot file
  343.     Private mConst_UncompressedSnapFile As String
  344.  
  345. 'Name of the Report we ' working with
  346.     Private m_strReportName As String
  347.  
  348. 'Instance returned from LoadLibrary calls
  349.     Private hLibDynaPDF As Long
  350.     Private hLibStrStorage As Long
  351.     '
  352.     '
  353.     '
  354.  
  355.  
  356. Public Function gfx_ConvertReportToPDF(Optional strReportName As String = "", Optional strSnapshotName As String = "", Optional strOutputPDFname As String = "", _
  357.                                        Optional blnShowSaveFileDialog As Boolean = False, Optional blnStartPDFViewer As Boolean = True, _
  358.                                        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
  359. On Error GoTo Err_ErrorHandler
  360. '  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  361. '  Converts a Snapshot Report to PDF
  362.  
  363. '  strReportName is the name of a report contained within this MDB
  364. '  strSnapshotName is the name of an existing Snapshot file
  365. '  strOutputPDFname is the name you select for the output PDF file
  366. '  blnShowSaveFileDialog is a boolean param to specify whether or not to display the standard windows File Dialog window to select an exisiting Snapshot file
  367. '  lngPDFNoFontEmbedding - Do not Embed fonts in PDF. Set to 1 to stop the default process of embedding all fonts in the output PDF.
  368. '  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  369.     Dim strSubCallingID As String
  370.         strSubCallingID = "modPDFCode : gfx_ConvertReportToPDF"
  371.  
  372.  
  373.     Dim strMonth As String
  374.         strMonth = IIf(Month(Now()) < 10, "0" & Month(Now()), Month(Now()))
  375.  
  376.    'Ensure there is a folder for the Current Date and Month
  377.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  378.     If strType = "Purchase Order" Then
  379.            'Check to see if the Year Exists
  380.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
  381.             If gfx_FolderExists(strFilePath) = False Then
  382.                'Creates the Year Folder
  383.                 MkDir strFilePath
  384.  
  385.             End If
  386.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
  387.  
  388.             strFilePath = strFilePath & "\" & strMonth
  389.  
  390.            'Check to see if the Month Exists
  391.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
  392.             If gfx_FolderExists(strFilePath) = False Then
  393.                'Creates the Month Folder
  394.                 MkDir strFilePath
  395.  
  396.             End If
  397.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
  398.  
  399.     ElseIf strType = "Sale Order" Then
  400.        'Check to see if the Year Exists
  401.        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
  402.         If gfx_FolderExists(strFilePath) = False Then
  403.            'Creates the Year Folder
  404.             MkDir strFilePath
  405.  
  406.         End If
  407.        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
  408.  
  409.         strFilePath = strFilePath & "\" & strMonth
  410.  
  411.        'Check to see if the Year Exists
  412.        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
  413.         If gfx_FolderExists(strFilePath) = False Then
  414.            'Creates the Month Folder
  415.             MkDir strFilePath
  416.  
  417.         End If
  418.        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
  419.     End If
  420.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  421.  
  422.  
  423.    'Verify both the DynaPDF.DLL and the strStorage.DLL are available
  424.         Dim blnFindDLLs As Boolean
  425.             blnFindDLLs = gfx_LoadLibrary()
  426.  
  427.        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  428.         If blnFindDLLs = False Then
  429.            'Cannot find DynaPDF.dll or StrStorage.dll file
  430.             Exit Function
  431.  
  432.         End If
  433.        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  434.  
  435.  
  436.    'Inititalize the string buffer for the File Path
  437.         Dim strPath  As String
  438.             strPath = Space(mConst_Pathlen)
  439.  
  440.  
  441.     'Save the ReportName to a module level variable
  442.         m_strReportName = strReportName
  443.  
  444.  
  445.    'Clears any existing Temp SnapShot file
  446.        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  447.         If Len(mConst_UncompressedSnapFile & vbNullString) > 0 Then
  448.             Kill mConst_UncompressedSnapFile
  449.             mConst_UncompressedSnapFile = ""
  450.  
  451.         End If
  452.        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  453.  
  454.  
  455.    'If we have been passed the name of a Snapshot file then skip the Snapshot creation process below
  456.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  457.      If Len(strSnapshotName & vbNullString) = 0 Then
  458.  
  459.        'Ensures a ReportName has been passed
  460.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
  461.             If Nz(strReportName, 0) = 0 Then
  462.                 MsgBox "  No valid Report Name has been found." & vbCrLf & "Contact your System Admin.", vbOKOnly + vbCritical, gName
  463.                 gfx_ConvertReportToPDF = False
  464.                 Exit Function
  465.  
  466.             End If
  467.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
  468.  
  469.         'Get the Systems Temp path & Returns Length of path(num characters in path)
  470.             Dim lngRet As Long
  471.                 lngRet = GetTempPath(mConst_Pathlen, strPath)
  472.  
  473.         'Chop off NULLS and trailing "\"
  474.             strPath = Left(strPath, lngRet) & Chr(0)
  475.  
  476.         'Specify a Unique File Name
  477.             Dim strPathandFileName  As String
  478.                 strPathandFileName = DLookup("[txtLocation]", "sysDirectories", "[txtDescription]='File Storage Directory'") & "\SP Connect.snp"  'gfx_GetUniqueFilename(strPath, "SP" & Chr(0), "snp")
  479.  
  480.         'Export the selected Report to SnapShot format
  481.              DoCmd.OutputTo acOutputReport, strReportName, "SnapshotFormat(*.snp)", strPathandFileName
  482.  
  483.         'Make sure the process has time to complete
  484.              DoEvents
  485.  
  486.     Else: ' 1
  487.         strPathandFileName = strSnapshotName
  488.  
  489.     End If
  490.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  491.  
  492.     Dim strOutputFile As String
  493.  
  494.  
  495.    'Decompress into same filename but change type to ".tmp"
  496.         Dim sPath As String * 512
  497.             lngRet = GetTempPath(512, sPath)
  498.  
  499.         Dim strEMFUncompressed As String
  500.             strEMFUncompressed = gfx_GetUniqueFilename(sPath, "SP", "tmp")
  501.  
  502.         lngRet = SetupDecompressOrCopyFile(strPathandFileName, strEMFUncompressed, 0&)
  503.             '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  504.              If lngRet <> 0 Then
  505.                 MsgBox "Cannot Decompress the SnapShot File" & vbCrLf & "Contact your System Admin.", vbOKOnly + vbCritical, gName
  506.                 gfx_ConvertReportToPDF = False
  507.                 Exit Function
  508.  
  509.              End If
  510.             '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  511.  
  512.  
  513.    'Set the uncompressed SnapShot file name variable
  514.         mConst_UncompressedSnapFile = strEMFUncompressed
  515.  
  516.  
  517.    'Cleanup the Temp SnapShot File if the Snapshot file name was not passed as the optional parameter
  518.        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  519.         If Len(strSnapshotName & vbNullString) = 0 Then
  520.             Kill strPathandFileName
  521.  
  522.         End If
  523.        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  524.  
  525.  
  526.     'Name output file the same as the input file name (w/ file extension .PDF) or show the File Save Dialog
  527.     '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  528.      If Len(strSnapshotName & vbNullString) = 0 Then
  529.        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
  530.         If blnShowSaveFileDialog = False Then
  531.            'Decompress into same filename but change type to ".tmp"
  532.  
  533.            'First see if an output PDF file name was passed
  534.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 3
  535.             If Len(strOutputPDFname & vbNullString) = 0 Then
  536.                 strOutputFile = Mid(strPathandFileName, 1, Len(strPathandFileName) - 3)
  537.                 strOutputFile = strOutputFile & "PDF"
  538.  
  539.             Else: ' 3
  540.                 strOutputFile = strOutputPDFname & "PDF"
  541.  
  542.             End If
  543.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 3
  544.  
  545.            'This is the name of and file path of the output PDF
  546.             strOutputFile = strFilePath & "\" & strOutputPDFname & ".PDF"
  547.  
  548.         Else: ' 2
  549.            'Call File Save Dialog
  550.             strOutputFile = gfx_fFileDialog()
  551.  
  552.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 3
  553.             If Len(strOutputFile & vbNullString) = 0 Then
  554.                 Exit Function
  555.  
  556.             End If
  557.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 3
  558.         End If
  559.        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
  560.  
  561.       Else:
  562.         'This is used if you specify the snapshot name instead of just passing the report name.
  563.  
  564.            'This is the name of and file path of the output PDF (changed - BD - Refer to original if trying to pass a snapshot name)
  565.             strOutputFile = strFilePath & "\" & strOutputPDFname & ".PDF"
  566.  
  567.       End If
  568.     '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  569.  
  570.  
  571.     'Call the ConvertUncompressedShapshot function in the StrStorage DLL (Note the Compression and Password params are not hooked up yet)
  572.     'NOTE: This is the point where the PDF is actually created
  573.          blnFindDLLs = ConvertUncompressedSnapshot(mConst_UncompressedSnapFile, strOutputFile, lngCompressionLevel, lngPDFNoFontEmbedding, lngPDFUnicodeFlags)
  574.  
  575.         '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  576.          If blnFindDLLs = False Then
  577.             MsgBox "The SnapShot File is damaged." & vbCrLf & "Contact your System Admin.", vbOKOnly + vbCritical, gName
  578.             gfx_ConvertReportToPDF = False
  579.             Exit Function
  580.  
  581.          End If
  582.         '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  583.  
  584.  
  585.     'Open new PDF in default PDF viewer
  586.        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  587.         If blnStartPDFViewer = True Then
  588.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
  589.             If MsgBox("Your PDF File has been created." & vbCrLf & "    Would you like to preview?", vbYesNo + vbQuestion, gName) = vbYes Then
  590.                 ShellExecuteA Application.hWndAccessApp, "open", strOutputFile, vbNullString, vbNullString, 1
  591.  
  592.             End If
  593.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 2
  594.         End If
  595.        '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  596.  
  597.     'Success
  598.      gfx_ConvertReportToPDF = True
  599.  
  600.  
  601. Exit_Err_ErrorHandler:
  602.     On Error Resume Next
  603.  
  604.    'Kill any existing Temp SnapShot file
  605.         Kill mConst_UncompressedSnapFile
  606.         mConst_UncompressedSnapFile = ""
  607.  
  608.    'Frees the Libraries
  609.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  610.     If hLibStrStorage <> 0 Then
  611.         hLibStrStorage = FreeLibrary(hLibStrStorage)
  612.  
  613.     End If
  614.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  615.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  616.     If hLibDynaPDF <> 0 Then
  617.         hLibDynaPDF = FreeLibrary(hLibDynaPDF)
  618.  
  619.     End If
  620.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  621.  
  622. Exit Function
  623.  
  624. Err_ErrorHandler:
  625.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  626.     If MsgBox("You have encountered an error.  Would you like to Email the issue to the Database Administrator?", vbYesNo + vbCritical, gName & " [" & strSubCallingID & "]") = vbYes Then
  627.         gfxErrorMessage Err.Number, Err.Description, "n/a", strSubCallingID, Screen.ActiveControl.Name
  628.     Else:
  629.         MsgBox Err.Description & vbCrLf & "Tell your system administrator you Received Error Code: " & Err.Number, vbCritical, gName & " [" & strSubCallingID & "]"
  630.     End If
  631.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  632.  
  633.     mConst_UncompressedSnapFile = ""
  634.     gfx_ConvertReportToPDF = False
  635.  
  636.     Resume Exit_Err_ErrorHandler
  637.  
  638. End Function
  639.  
  640.  
  641. Private Function gfx_LoadLibrary() As Boolean
  642. On Error Resume Next
  643. '  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  644. '  Ensures that the Library DLL has been loaded OR calls the library to be loaded
  645. '  Step 1 of
  646. '  NOTE:  If you are going to process many reports at once then to improve performance you should only call gfx_LoadLibrary once.
  647. '  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  648.     Dim strSubCallingID As String
  649.         strSubCallingID = "modPDFCode : gfx_LoadLibrary"
  650.  
  651.  
  652.     '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  653.     'PRELIMINARY:
  654.     '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  655.  
  656.        'Resets the Variable
  657.             gfx_LoadLibrary = False
  658.  
  659.  
  660.     '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  661.     'Step 1:    Load the DynaPDF.DLL File
  662.     '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  663.  
  664.        'If we aready loaded hLibDynaPDF (<>0) then free the library
  665.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  666.             If hLibDynaPDF <> 0 Then
  667.                hLibDynaPDF = FreeLibrary(hLibDynaPDF)
  668.  
  669.             End If
  670.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  671.  
  672.        'First, try to load the DLL, assuming it is in the same folder as this MDB.
  673.            'hLibDynaPDF = LoadLibrary(gfx_CurrentDBDir() & "\Reference\DynaPDF.dll")
  674.            '9*9*9*9*9*9*9  
  675.             Dim str As String
  676.                 str = "C:\SP Connect\System\Reference\DynaPDF.dll"
  677.  
  678.             hLibDynaPDF = LoadLibrary(str)
  679.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  680.             If hLibDynaPDF = 0 Then
  681.                'Second, (if hLibDynaPDF still = 0) try to load the DLL From Window System folder
  682.                 hLibDynaPDF = LoadLibrary("C:\SP Connect\System\Reference\DynaPDF.dll")
  683.  
  684.             End If
  685.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  686.  
  687.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  688.             If hLibDynaPDF = 0 Then
  689.                'Third, (if hLibDynaPDF still = 0) try to load the DLL From Window System folder
  690.                 hLibDynaPDF = LoadLibrary("DynaPDF.dll")
  691.  
  692.             End If
  693.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  694.  
  695.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  696.             If hLibDynaPDF = 0 Then
  697.                'Forth, (if hLibDynaPDF still = 0) try to load the DLL From Access Folder
  698.                 hLibDynaPDF = LoadLibrary("C:\Program Files (x86)\Microsoft Office\Office14\DynaPDF.dll")
  699.  
  700.             End If
  701.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  702.  
  703.        'Cancels the function if the DLL file cannot be found
  704.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  705.             If hLibDynaPDF = 0 Then
  706.                 MsgBox "     The DynaPDF.dll file is Missing." & vbCrLf & "Please contact your Database Admin.", vbOKOnly + vbCritical, gName
  707.                 gfx_LoadLibrary = False
  708.                 Exit Function
  709.  
  710.             End If
  711.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  712.  
  713.  
  714.  
  715.     '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  716.     'Step 2:    Load the StrStorage.DLL File
  717.     '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  718.  
  719.         'If we aready loaded hLibStrStorage (<>0) then free the library
  720.             '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  721.              If hLibStrStorage <> 0 Then
  722.                  hLibStrStorage = FreeLibrary(hLibStrStorage)
  723.  
  724.              End If
  725.             '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  726.  
  727.        'First, try to load the DLL, assuming it is in the same folder as this MDB.
  728.             hLibStrStorage = LoadLibrary(gfx_CurrentDBDir() & "\Reference\StrStorage.dll")
  729.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  730.             If hLibStrStorage = 0 Then
  731.                'Second, (if hLibStrStorage still = 0) try to load the DLL From Window System folder
  732.                 hLibStrStorage = LoadLibrary("StrStorage.dll")
  733.  
  734.             End If
  735.            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  736.  
  737.        'Cancels the function if the DLL file cannot be found
  738.             '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  739.              If hLibStrStorage = 0 Then
  740.                  MsgBox "             The StrStorage.dll file is Missing." & vbCrLf & "Please contact your Database Admin.", vbOKOnly + vbCritical, gName
  741.                  gfx_LoadLibrary = False
  742.                  Exit Function
  743.  
  744.              End If
  745.             '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  746.  
  747.  
  748.     '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  749.     'Step 3: Set the Variable to Successful
  750.     '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  751.  
  752.        'Resets the Variable
  753.             gfx_LoadLibrary = True
  754.  
  755.  
  756. End Function
  757.  
  758.  
  759. Private Function gfx_GetUniqueFilename(Optional strFilePath As String = "", Optional strPrefix As String = "", Optional strUseExtension As String = "") As String
  760. On Error GoTo Err_ErrorHandler
  761. '  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  762. '  Assigns a Unique File Name
  763. '  Originally Posted by Terry Kreft <terry.kreft@mps.co.uk>
  764. '  Note: Input strings must be NULL terminated; here it is done by the calling function.
  765. '  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  766.     Dim strSubCallingID As String
  767.         strSubCallingID = "gfx_GetUniqueFilename"
  768.  
  769.  
  770.     Dim lngUniqueID As Long
  771.         lngUniqueID = 0
  772.  
  773.     Dim strTempFileName As String
  774.     Dim lngRet As Long
  775.  
  776.    'If No file Path has been specified, the default is the current directory
  777.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  778.     If strFilePath = "" Then
  779.        strFilePath = CurDir
  780.  
  781.     End If
  782.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  783.  
  784.     strTempFileName = String(mCosnt_MaxPath, 0)
  785.     lngRet = GetTempFileName(strFilePath, strPrefix, lngUniqueID, strTempFileName)
  786.  
  787.     strTempFileName = Left(strTempFileName, InStr(strTempFileName, Chr(0)) - 1)
  788.  
  789.     Call Kill(strTempFileName)
  790.  
  791.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  792.     If Len(strUseExtension) > 0 Then
  793.         strTempFileName = Left(strTempFileName, Len(strTempFileName) - 3) & strUseExtension
  794.  
  795.     End If
  796.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  797.  
  798.     gfx_GetUniqueFilename = strTempFileName
  799.  
  800. Exit_Err_ErrorHandler:
  801.     Exit Function
  802.  
  803. Err_ErrorHandler:
  804.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  805.     If MsgBox("You have encountered an error.  Would you like to Email the issue to the Database Administrator?", vbYesNo + vbCritical, gName & " [" & strSubCallingID & "]") = vbYes Then
  806.         gfxErrorMessage Err.Number, Err.Description, "n/a", strSubCallingID, Screen.ActiveControl.Name
  807.     Else:
  808.         MsgBox Err.Description & vbCrLf & "Tell your system administrator you Received Error Code: " & Err.Number, vbCritical, gName & " [" & strSubCallingID & "]"
  809.     End If
  810.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  811.     Resume Exit_Err_ErrorHandler
  812.  
  813. End Function
  814.  
  815.  
  816. Private Function gfx_fFileDialog() As String
  817. On Error GoTo Err_ErrorHandler
  818. '  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  819. '  Calls the API File Save Dialog Window; Returns full path to new File
  820. '  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  821.     Dim strSubCallingID As String
  822.         strSubCallingID = "gfx_fFileDialog"
  823.  
  824.  
  825.    'Call the File Common Dialog Window
  826.         Dim clsDialog As Object
  827.         Dim strTemp As String
  828.         Dim strFname As String
  829.  
  830.         Set clsDialog = New clsCommonDialog
  831.  
  832.     clsDialog.Filter = "PDF (*.PDF)" & Chr$(0) & "*.PDF" & Chr$(0)
  833.     clsDialog.hDC = 0
  834.     clsDialog.MaxFileSize = 256
  835.     clsDialog.Max = 256
  836.     clsDialog.FileTitle = vbNullString
  837.     clsDialog.DialogTitle = gName & ":  Please Select a path and Enter a Name for the PDF File"
  838.     clsDialog.InitDir = vbNullString
  839.     clsDialog.DefaultExt = vbNullString
  840.  
  841.    'Display the File Dialog
  842.     clsDialog.ShowSave
  843.  
  844.    'See if user clicked Cancel or even selected the very same file already selected
  845.     strFname = clsDialog.FileName
  846.  
  847.    'Return File Path and Name
  848.     gfx_fFileDialog = strFname
  849.  
  850. Exit_Err_ErrorHandler:
  851.     Exit Function
  852.  
  853. Err_ErrorHandler:
  854.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  855.     If MsgBox("You have encountered an error.  Would you like to Email the issue to the Database Administrator?", vbYesNo + vbCritical, gName & " [" & strSubCallingID & "]") = vbYes Then
  856.         gfxErrorMessage Err.Number, Err.Description, "n/a", strSubCallingID, Screen.ActiveControl.Name
  857.     Else:
  858.         MsgBox Err.Description & vbCrLf & "Tell your system administrator you Received Error Code: " & Err.Number, vbCritical, gName & " [" & strSubCallingID & "]"
  859.     End If
  860.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  861.     Resume Exit_Err_ErrorHandler
  862.  
  863. End Function
  864.  
  865.  
  866. Public Function gfx_fFileDialogSnapshot() As String
  867. On Error GoTo Err_ErrorHandler
  868. '  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  869. ' Calls the API File Open Dialog Window
  870. ' Returns full path to existing Snapshot File
  871. '  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  872.     Dim strSubCallingID As String
  873.         strSubCallingID = "gfx_fFileDialogSnapshot"
  874.  
  875.  
  876.    'Call the File Common Dialog Window
  877.     Dim clsDialog As Object
  878.     Dim strTemp As String
  879.     Dim strFname As String
  880.  
  881.     Set clsDialog = New clsCommonDialog
  882.  
  883.         clsDialog.Filter = "SNAPSHOT (*.SNP)" & Chr$(0) & "*.SNP" & Chr$(0)
  884.         clsDialog.hDC = 0
  885.         clsDialog.MaxFileSize = 256
  886.         clsDialog.Max = 256
  887.         clsDialog.FileTitle = vbNullString
  888.         clsDialog.DialogTitle = "Please Select a Snapshot File"
  889.         clsDialog.InitDir = vbNullString
  890.         clsDialog.DefaultExt = vbNullString
  891.  
  892.    'Display the File Dialog
  893.         clsDialog.ShowOpen
  894.  
  895.    'See if user clicked Cancel or even selected the very same file already selected
  896.         strFname = clsDialog.FileName
  897.  
  898.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  899.     If Len(strFname & vbNullString) = 0 Then
  900.         'Do nothing. Add your desired error logic here.
  901.  
  902.     End If
  903.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  904.  
  905.    'Return File Path and Name
  906.     gfx_fFileDialogSnapshot = strFname
  907.  
  908. Exit_Err_ErrorHandler:
  909.     Err.Clear
  910.     Set clsDialog = Nothing
  911.     Exit Function
  912.  
  913. Err_ErrorHandler:
  914.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  915.     If MsgBox("You have encountered an error.  Would you like to Email the issue to the Database Administrator?", vbYesNo + vbCritical, gName & " [" & strSubCallingID & "]") = vbYes Then
  916.         gfxErrorMessage Err.Number, Err.Description, "n/a", strSubCallingID, Screen.ActiveControl.Name
  917.     Else:
  918.         MsgBox Err.Description & vbCrLf & "Tell your system administrator you Received Error Code: " & Err.Number, vbCritical, gName & " [" & strSubCallingID & "]"
  919.     End If
  920.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  921.  
  922.     gfx_fFileDialogSnapshot = ""
  923.  
  924.     Resume Exit_Err_ErrorHandler
  925.  
  926. End Function
  927.  
  928.  
  929. Public Function gfx_fFileDialogSavePDFname() As String
  930. On Error GoTo Err_ErrorHandler
  931. '  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  932. ' Calls the API File Open Dialog Window
  933. ' Returns full path to existing Snapshot File
  934. '  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  935.     Dim strSubCallingID As String
  936.         strSubCallingID = "gfx_fFileDialogSavePDFname"
  937.  
  938.  
  939.    'Call the File Common Dialog Window
  940.     Dim clsDialog As Object
  941.     Dim strTemp As String
  942.     Dim strFname As String
  943.  
  944.     Set clsDialog = New clsCommonDialog
  945.  
  946.         clsDialog.Filter = "PDF (*.PDF)" & Chr$(0) & "*.PDF" & Chr$(0)
  947.         clsDialog.hDC = 0
  948.         clsDialog.MaxFileSize = 256
  949.         clsDialog.Max = 256
  950.         clsDialog.FileTitle = vbNullString
  951.         clsDialog.DialogTitle = "Please Select a name for the PDF File"
  952.         clsDialog.InitDir = vbNullString
  953.         clsDialog.DefaultExt = vbNullString
  954.  
  955.  
  956.    'Display the File Dialog
  957.         clsDialog.ShowOpen
  958.  
  959.    'See if user clicked Cancel or even selected the very same file already selected
  960.         strFname = clsDialog.FileName
  961.  
  962.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  963.     If Len(strFname & vbNullString) = 0 Then
  964.         'Do nothing. Add your desired error logic here.
  965.  
  966.     End If
  967.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1
  968.  
  969.    'Return File Path and Name
  970.      gfx_fFileDialogSavePDFname = strFname
  971.  
  972. Exit_Err_ErrorHandler:
  973.     Err.Clear
  974.     Set clsDialog = Nothing
  975.     Exit Function
  976.  
  977. Err_ErrorHandler:
  978.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  979.     If MsgBox("You have encountered an error.  Would you like to Email the issue to the Database Administrator?", vbYesNo + vbCritical, gName & " [" & strSubCallingID & "]") = vbYes Then
  980.         gfxErrorMessage Err.Number, Err.Description, "n/a", strSubCallingID, Screen.ActiveControl.Name
  981.     Else:
  982.         MsgBox Err.Description & vbCrLf & "Tell your system administrator you Received Error Code: " & Err.Number, vbCritical, gName & " [" & strSubCallingID & "]"
  983.     End If
  984.    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  985.  
  986.     gfx_fFileDialogSavePDFname = ""
  987.  
  988.     Resume Exit_Err_ErrorHandler
  989.  
  990. End Function
  991.  
Dec 8 '13 #6

zmbd
Expert Mod 5K+
P: 5,287
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
Expand|Select|Wrap|Line Numbers
  1. 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).
Dec 8 '13 #7

100+
P: 107
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
Dec 8 '13 #8

Post your reply

Sign in to post your reply or Sign up for a free account.