Set output file name and path for docPrint PDF Driver

You can use following sample code to set the output file name to docPrint PDF Driver, when you print a document to docPrint PDF Driver, it will not popup Save As dialog,
========================================================= 

Option Explicit

Const SW_SHOWNORMAL = 1

Private Type DOCINFO
  cbSize As Long
  lpszDocName As String
  lpszOutput As String
  lpszDatatype As String
  fwType As Long
End Type
Private Type MyPrinterInfo
  Handle As Long
  dpiX As Long
  dpiY As Long
  OffsetX As Long ' the position of the top left corner of the
  OffsetY As Long ' "printable area" of the page
End Type

Private Declare Function StartDoc Lib "gdi32" Alias _
  "StartDocA" (ByVal hdc As Long, lpdi As DOCINFO) As Long
Private Declare Function EndDoc Lib "gdi32" _
  (ByVal hdc As Long) As Long
Private Declare Function StartPage Lib "gdi32" _
  (ByVal hdc As Long) As Long
Private Declare Function EndPage Lib "gdi32" _
  (ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" _
  (ByVal hdc As Long, ByVal nindex As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" _
  (ByVal hdc As Long) As Long
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Const PHYSICALOFFSETX = 112
Private Const PHYSICALOFFSETY = 113
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 Declare Function CreateFontIndirect Lib "gdi32" _
Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias _
"TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal _
y As Long, ByVal lpString As String, ByVal nCount _
As Long) As Long

Private Declare Function WritePrivateProfileString Lib "kernel32" Alias _
    "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
         ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName _
         As String) As Long
Private Declare Function GetDefaultPrinter Lib "winspool.drv" Alias _
"GetDefaultPrinterA" (ByVal pszbuffer As String, pcchbuffer As Long) As Long
Private Declare Function SetDefaultPrinter Lib "winspool.drv" Alias _
"SetDefaultPrinterA" (ByVal pszbuffer As String) As Long

Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" 
    (ByVal pPrinterName _
    As String, phPrinter As Long, pDefault As Any) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter _
         As Long) As Long
Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeletevalueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (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 Sub docPrint_Register Lib "doc2img.dll" (ByVal lpOrderID As String, ByVal lpCompanyName As String)
Private Declare Function docPrint_SetOptions Lib "doc2img.dll" (ByVal lpKeyName As String, ByVal lpString As String) As Long
Private Declare Function docPrint_DocumentConverter Lib "doc2img.dll" (ByVal lpDocFile As String, ByVal lpOutputFile As String, ByVal lpOptions As String) As Long
Private Declare Function docPrint_DocumentConverterEx Lib "doc2img.dll" (ByVal lpUserName As String, ByVal lpPassword As String, ByVal lpDocFile As String, ByVal lpOutputFile As String, ByVal lpOptions As String) As Long

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const REG_NONE = 0
Private Const REG_SZ = 1
Private Const REG_EXPAND_SZ = 2
Private Const REG_BINARY = 3
Private Const REG_DWORD = 4
Private Const REG_DWORD_BIG_ENDIAN = 5
Private Const REG_MULTI_SZ = 7
'You can select docPrint or docPrint PDF Driver printers at here

Const sPrinterName = "docPrint"
'Const sPrinterName = "docPrint PDF Driver"
'Default output filename, you can change it to anything that you want

Const szOutputFileName = "C:\docPrint_output%d.tif"
'Const szOutputFileName = "C:\docPrint_output.bmp"

Private MyPrinter As MyPrinterInfo


Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long 'retrieve information about the key lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize) If lResult = 0 Then If lValueType = REG_SZ Then 'Create a buffer strBuf = String(lDataBufSize, Chr$(0)) 'retrieve the key's content lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize) If lResult = 0 Then 'Remove the unnecessary chr$(0)'s RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1) End If ElseIf lValueType = REG_BINARY Then Dim strData As Integer 'retrieve the key's value lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize) If lResult = 0 Then RegQueryStringValue = strData End If End If End If End Function
Function GetString(hKey As Long, strPath As String, strValue As String) Dim Ret 'Open the key RegOpenKey hKey, strPath, Ret 'Get the key's content GetString = RegQueryStringValue(Ret, strValue) 'Close the key RegCloseKey Ret End Function
Sub SaveString(hKey As Long, strPath As String, strValue As String, strData As String) Dim Ret 'Create a new key RegCreateKey hKey, strPath, Ret 'Save a string to the key RegSetValueEx Ret, strValue, 0, REG_SZ, ByVal strData, LenB(strData) 'close the key RegCloseKey Ret End Sub
Sub SaveStringLong(hKey As Long, strPath As String, strValue As String, strData As Long) Dim Ret 'Create a new key RegCreateKey hKey, strPath, Ret 'Set the key's value RegSetValueEx Ret, strValue, 0, REG_DWORD, strData, 4 'close the key RegCloseKey Ret End Sub
Sub DelSetting(hKey As Long, strPath As String, strValue As String) Dim Ret 'Create a new key RegCreateKey hKey, strPath, Ret 'Delete the key's value RegDeleteValue Ret, strValue 'close the key RegCloseKey Ret End Sub
Private Sub SetOutputFileName(ByVal m_ptrOutputFile As String) SetOutputFileName_docPrintPDFDriver m_ptrOutputFile Dim m_szIniFilename As String m_szIniFilename = GetString(HKEY_LOCAL_MACHINE, "SOFTWARE\verypdf\docprint", "ConfigFile") SetDefaultPrinter sPrinterName 'Set the output filename to docPrint WritePrivateProfileString "AutoSave", "IsAutoSave", "1", m_szIniFilename WritePrivateProfileString "AutoSave", "OutputFile", m_ptrOutputFile, m_szIniFilename WritePrivateProfileString "AutoSaveOptions", "m_bCreateFileForEachPage", "1", m_szIniFilename WritePrivateProfileString "AutoSaveOptions", "m_strColorDepth", "24", m_szIniFilename WritePrivateProfileString "AutoSaveOptions", "m_strResolution", "400x400", m_szIniFilename WritePrivateProfileString "AutoSaveOptions", "m_bGrayscale", "0", m_szIniFilename 'Use run length compression arithmetic for TIFF file WritePrivateProfileString "AutoSaveOptions", ".tif", "-compress rle", m_szIniFilename End Sub
Private Sub SetOutputFileName_docPrintPDFDriver(ByVal m_ptrOutputFile As String) SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "AutomaticOutput", 1 SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "AutomaticValue", 2 SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "AutoView", 0 'SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "EmbedNum", 0 SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "Unit", 3 SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "PageSelect", 10 SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "PageSize", 7 SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "Bitcount", 1 SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "xResolution", 300 SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "yResolution", 300 SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "PageW", 0 SaveStringLong HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "PageH", 0 SaveString HKEY_CURRENT_USER, "Software\verypdf\pdfcamp", "AutomaticDirectory", m_ptrOutputFile End Sub
Private Sub Command1_Click() End Sub
Private Sub DOC2EPS_Click() Dim iret As Long iret = docPrint_DocumentConverter("C:\test_word.doc", "C:\test_word.pdf", "") iret = docPrint_DocumentConverter("C:\test_word.doc", "C:\test_word.ps", "") iret = docPrint_DocumentConverter("C:\test_word.doc", "C:\test_word.eps", "") End Sub
Private Function GetMyPrinter() As Boolean CommonDialog1.PrinterDefault = False CommonDialog1.Flags = cdlPDReturnDC Or cdlPDPrintSetup CommonDialog1.CancelError = True On Error GoTo UserCancel CommonDialog1.ShowPrinter MyPrinter.Handle = CommonDialog1.hdc MyPrinter.dpiX = GetDeviceCaps(MyPrinter.Handle, LOGPIXELSX) MyPrinter.dpiY = GetDeviceCaps(MyPrinter.Handle, LOGPIXELSY) MyPrinter.OffsetX = GetDeviceCaps(MyPrinter.Handle, PHYSICALOFFSETX) MyPrinter.OffsetY = GetDeviceCaps(MyPrinter.Handle, PHYSICALOFFSETY) GetMyPrinter = True Exit Function UserCancel: GetMyPrinter = False End Function
Private Sub PrinterText(s1 As String, x As Single, y As Single) Dim xpos As Long, ypos As Long xpos = x * MyPrinter.dpiX - MyPrinter.OffsetX ypos = y * MyPrinter.dpiY - MyPrinter.OffsetY TextOut MyPrinter.Handle, xpos, ypos, s1, Len(s1) End Sub
Private Sub DocumentConverterDLL_Click() Dim iret As Long Dim strOptions As String docPrint_Register "XXXXXXXXXX", "XXXX Corporation" 'Please run following command line to get more options for doc2pdf converter 'C:\>"C:\Program Files\docPrint Pro v3.3\doc2pdf.exe" -? ' '-j <Subject> : subject '-t <Title> : title '-a <Author> : author '-k <Keywords> : keywords '-g <Page range> : page range for conversion, eg: 1,2-4,6 '-G : don't append suffix to filename for single page file '-p <Output Flag> : a flag for PDF output ' -p 0: overwrite if PDF file exists ' -p 1: insert before first page if PDF file exists ' -p 2: append to last page if PDF file exists ' -p 3: rename filename if PDF file exists '-b <Color type> : specify color type for output file ' -b 1: output black and white image file ' -b 8: output 256 colors image file ' -b 24: output True Colors image file '-R <Rotate> : rotate page 90, 180, 270 angle '-r <resolution> : set resolution in generated image file ' -r 300 : set X and Y resolution within document to image conversion ' -r 300x600 : set X and Y resolution within document to image conversion ' -r 200x300 : set X and Y resolution within document to image conversion '-w <image width> : fix the paper width within document to image conversion '-h <image height> : fix the paper height within document to image conversion '-f <paper size> : set the paper size for HTML and XLS to PDF conversion '-z <PrintZoomPaper>: set print zoom paper for MS Office document printing ' -z 12240x15840 : scale to Letter print paper size ' -z 11907x16839 : scale to A4 print paper size '-V : view the generated PDF file automatically '-d : hide MS Office printing dialog within conversion strOptions = strOptions + "-b 1" 'Create 1 bit image file strOptions = strOptions + " -r 300x300" 'Set 300 DPI for conversion 'Convert XLS to a multipage TIFF file iret = docPrint_DocumentConverter("C:\test_excel.xls", "C:\test1_excel.tif", strOptions) 'Convert XLS to a multiple single page TIFF files iret = docPrint_DocumentConverter("C:\test_excel.xls", "C:\test2_excel-%03d.tif", strOptions) 'Convert DOC to a multiple page TIFF file iret = docPrint_DocumentConverter("C:\test_word.doc", "C:\test1_word.tif", "-b 1 -r 300x300") 'Convert DOC to a multiple single page TIFF files iret = docPrint_DocumentConverter("C:\test_word.doc", "C:\test2_word-%03d.tif", "-b 1 -r 300x300") 'Convert DOC to a multiple page TIFF file iret = docPrint_DocumentConverter("C:\test_word.doc", "C:\test_word.pdf", "") MsgBox "Conversion Finished" ShellExecute 0, "open", "C:\test_word.pdf", vbNullString, vbNullString, SW_SHOWNORMAL End Sub
Private Sub GDIDrawing_Click() Dim iret As Long, n As Long Dim s1 As String, xpos As Long, ypos As Long Dim docinf As DOCINFO ' set up an initial font Dim log_font As LOGFONT, new_font As Long, old_font As Long SetOutputFileName_docPrintPDFDriver "C:\output.eps" SetDefaultPrinter "docPrint PDF Driver" If Not GetMyPrinter Then Exit Sub With log_font .lfEscapement = 0 ' desired rotation in tenths of a degree .lfHeight = 12 * (-MyPrinter.dpiY / 72) ' 12 points .lfFaceName = "Times New Roman" & vbNullChar .lfWeight = 400 ' standard (bold = 700) .lfItalic = False .lfUnderline = False End With new_font = CreateFontIndirect(log_font) old_font = SelectObject(MyPrinter.Handle, new_font) ' start a document docinf.cbSize = Len(docinf) ' Size of DOCINFO structure iret = StartDoc(MyPrinter.Handle, docinf) 'Start new document iret = StartPage(MyPrinter.Handle) 'Start a new page ' ' print a simple line of text at position (1, 1) (inches) For n = 1 To 10 PrinterText "This is Line " & Format(n), 1, 1 * 0.16 * n Next n ' end page iret = EndPage(MyPrinter.Handle) 'End the page ' end the document SelectObject MyPrinter.Handle, old_font DeleteObject new_font ' clear up the font iret = EndDoc(MyPrinter.Handle) 'End the print job iret = DeleteDC(MyPrinter.Handle) End Sub
Private Sub GDIFuncs_Click() Dim mytest As String Dim width As Long Dim height As Long SetOutputFileName szOutputFileName mytest = "This is a test!" width = Printer.TextWidth(mytest) / 2 height = Printer.TextHeight(mytest) / 2 Printer.CurrentX = Printer.ScaleWidth / 2 - width Printer.CurrentY = Printer.ScaleHeight / 2 - height Printer.Print mytest Printer.Circle (200, 200), 1200, RGB(255, 0, 0) Printer.EndDoc End Sub
Private Sub PrintAccess_Click() Dim bFlag As Boolean SetOutputFileName szOutputFileName On Error GoTo FileOpenDlg_ErrHandler FileOpenDlg.CancelError = True FileOpenDlg.Flags = cdlOFNFileMustExist Or cdlOFNPathMustExist Or cdlOFNExplorer Or cdlOFNLongNames FileOpenDlg.Filter = "MS PowerPoint presentations (*.mdb)|*.mdb" FileOpenDlg.FilterIndex = 1 FileOpenDlg.ShowOpen Dim appAccess As Object Set appAccess = CreateObject("Access.Application") With appAccess .OpenCurrentDatabase (FileOpenDlg.FileName) '.Reports("myreport").Print ' --OR-- '.DoCmd.OpenReport "myreport", acViewNormal .DoCmd.OpenReport ("myreport") .CloseCurrentDatabase .Quit End With Set appAccess = Nothing FileOpenDlg_ErrHandler: Exit Sub End Sub
Private Sub PrintBMP_Click() On Error GoTo FileOpenDlg_ErrHandler FileOpenDlg.CancelError = True FileOpenDlg.Flags = cdlOFNFileMustExist Or cdlOFNPathMustExist Or cdlOFNExplorer Or cdlOFNLongNames FileOpenDlg.Filter = "Image file (Bitmap, JPEG, GIF or Metafile)|*.bmp;*.jpg;*.gif;*.wmf;*.emf" FileOpenDlg.FilterIndex = 1 FileOpenDlg.ShowOpen On Error GoTo LoadPic_ErrHandler Picture1.Picture = LoadPicture(FileOpenDlg.FileName) On Error GoTo 0 SetOutputFileName szOutputFileName Printer.CurrentX = 0 Printer.CurrentY = 0 Call Printer.PaintPicture(Picture1.Picture, 0, 0) Printer.EndDoc Picture1.Picture = Nothing FileOpenDlg_ErrHandler: LoadPic_ErrHandler: End Sub
Private Sub PrintPDF_Click() ' You need install the full version of Acrobat into order to get function to work SetOutputFileName szOutputFileName On Error GoTo FileOpenDlg_ErrHandler FileOpenDlg.CancelError = True FileOpenDlg.Flags = cdlOFNFileMustExist Or cdlOFNPathMustExist Or cdlOFNExplorer Or cdlOFNLongNames FileOpenDlg.Filter = "Adobe Acrobat documents (*.pdf)|*.pdf" FileOpenDlg.FilterIndex = 1 FileOpenDlg.ShowOpen On Error GoTo 0 Dim acroApp As Object Dim acroAVDoc As Object Dim acroPDDoc As Object Dim nPages As Long Set acroApp = CreateObject("AcroExch.App") Set acroAVDoc = CreateObject("AcroExch.AVDoc") If acroAVDoc.Open(FileOpenDlg.FileName, "") = True Then Set acroPDDoc = acroAVDoc.GetPDDoc() nPages = acroPDDoc.GetNumPages() acroAVDoc.PrintPages 0, nPages - 1, 0, 1, 1 acroAVDoc.Close 1 Set acroAVDoc = Nothing Set acroPDDoc = Nothing End If Call acroApp.Exit Set acroApp = Nothing FileOpenDlg_ErrHandler: Exit Sub End Sub
Private Sub PrintPPT_Click() ' You need install MS PowerPoint in order to get this function to work Dim bFlag As Boolean SetOutputFileName szOutputFileName On Error GoTo FileOpenDlg_ErrHandler FileOpenDlg.CancelError = True FileOpenDlg.Flags = cdlOFNFileMustExist Or cdlOFNPathMustExist Or cdlOFNExplorer Or cdlOFNLongNames FileOpenDlg.Filter = "MS PowerPoint presentations (*.ppt)|*.ppt" FileOpenDlg.FilterIndex = 1 FileOpenDlg.ShowOpen On Error Resume Next Dim pptApp As Object Dim ppPresent As Object Set pptApp = CreateObject("PowerPoint.Application") Err = 0 Set ppPresent = pptApp.Presentations.Open(FileOpenDlg.FileName, 1, 1, 0) If Err = 0 Then ppPresent.PrintOptions.PrintInBackground = 0 ppPresent.PrintOptions.ActivePrinter = sPrinterName With ppPresent bFlag = .PrintOptions.PrintInBackground .PrintOptions.PrintInBackground = False .PrintOptions.PrintColorType = 1 .PrintOut Copies:=1, Collate:=True .PrintOptions.PrintInBackground = bFlag .Saved = True .Close End With Call ppPresent.Close Set ppPresent = Nothing End If Call pptApp.Quit Set pptApp = Nothing FileOpenDlg_ErrHandler: Exit Sub End Sub
Private Sub PrintVisio_Click() ' You need install MS Visio 2000 in order to get this function to work SetOutputFileName szOutputFileName On Error GoTo FileOpenDlg_ErrHandler FileOpenDlg.CancelError = True FileOpenDlg.Flags = cdlOFNFileMustExist Or cdlOFNPathMustExist Or cdlOFNExplorer Or cdlOFNLongNames FileOpenDlg.Filter = "MS Visio drawings (*.vsd)|*.vsd" FileOpenDlg.FilterIndex = 1 FileOpenDlg.ShowOpen On Error Resume Next Dim visioApp As Object Dim drawing As Object Dim Page As Object Set visioApp = CreateObject("Visio.Application") Err = 0 Set drawing = visioApp.Documents.OpenEx(FileOpenDlg.FileName, &H20 And &H8) If Err = 0 Then drawing.Mode = 0 drawing.PrintCenteredH = 1 drawing.PrintCenteredV = 1 drawing.PrintFitOnPages = 1 drawing.PrintOut (0) drawing.Saved = 1 drawing.Close Set drawing = Nothing End If Call visioApp.Quit Set visioApp = Nothing FileOpenDlg_ErrHandler: Exit Sub End Sub
Private Sub PrintWord_Click() ' You need install MS Word in order to get this function to work SetOutputFileName szOutputFileName On Error GoTo FileOpenDlg_ErrHandler FileOpenDlg.CancelError = True FileOpenDlg.Flags = cdlOFNFileMustExist Or cdlOFNPathMustExist Or cdlOFNExplorer Or cdlOFNLongNames FileOpenDlg.Filter = "MS Word documents (*.doc)|*.doc" FileOpenDlg.FilterIndex = 1 FileOpenDlg.ShowOpen On Error Resume Next Dim wordApp As Object Dim wDoc As Object Set wordApp = CreateObject("Word.Application") Err = 0 Set wDoc = wordApp.Documents.Open(FileOpenDlg.FileName, , 1) If Err = 0 Then wordApp.ActivePrinter = sPrinterName Call wordApp.PrintOut(False) wDoc.Close Set wDoc = Nothing End If Call wordApp.Quit Set wordApp = Nothing FileOpenDlg_ErrHandler: Exit Sub End Sub
Private Sub PrintXLS_Click() ' You need install MS Excel in order to get this function to work SetOutputFileName szOutputFileName On Error GoTo FileOpenDlg_ErrHandler FileOpenDlg.CancelError = True FileOpenDlg.Flags = cdlOFNFileMustExist Or cdlOFNPathMustExist Or cdlOFNExplorer Or cdlOFNLongNames FileOpenDlg.Filter = "MS Excel worksheets (*.xls)|*.xls" FileOpenDlg.FilterIndex = 1 FileOpenDlg.ShowOpen On Error Resume Next Dim exclApp As Object Dim xlWB As Object Set exclApp = CreateObject("Excel.Application") Err = 0 Set xlWB = exclApp.Workbooks.Open(FileOpenDlg.FileName, , True) If Err = 0 Then Call exclApp.Worksheets.PrintOut(, , , , sPrinterName) Call xlWB.Close Set xlWB = Nothing End If Call exclApp.Quit Set exclApp = Nothing FileOpenDlg_ErrHandler: Exit Sub End Sub

 

VN:F [1.9.20_1166]
Rating: 0.0/10 (0 votes cast)
VN:F [1.9.20_1166]
Rating: 0 (from 0 votes)

Related Posts

Leave a Reply

Your email address will not be published. Required fields are marked *


Verify Code   If you cannot see the CheckCode image,please refresh the page again!