Option Explicit



‘Declarations for Windows API calls – read and write registry keys



Public Const HKEY_CURRENT_USER = &H80000001

Public Const REG_SZ = 1

Public Const KEY_ALL_ACCESS = &H3F


Private Declare Function GetWindowsDirectory Lib "kernel32" _

    Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, _

    ByVal nSize As Long) As Long


Public Declare Function GetSystemDirectory Lib "kernel32" _

    Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, _

    ByVal nSize As Long) As Long


Public Declare Function RegCloseKey Lib "advapi32.dll" _

    (ByVal hKey As Long) As Long


Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _

      "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey _

      As String, ByVal ulOptions As Long, ByVal samDesired _

      As Long, phkResult As Long) As Long


Public 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


Public Declare Function GetVersionExA Lib "kernel32" _

      (lpVersionInformation As OSVERSIONINFO) As Integer



      dwOSVersionInfoSize As Long

      dwMajorVersion As Long

      dwMinorVersion As Long

      dwBuildNumber As Long

      dwPlatformId As Long

      szCSDVersion As String * 128

   End Type



Sub PDFWriter_Convert_Doc2PDF_Dialog_Box()



'This will convert multiple MS Word documents to PDF files


'Code for Acrobat 5 - PDFMaker


'Must Set reference to Microsoft Word object library


Dim loWord      As Word.Application

Dim lsPrinter   As String       'System default printer

Dim lsPort      As String       'DOS definition - LPT1:

Dim lsVersion   As String       'Windows version


Dim MyPathFrom  As String

Dim MyPathTO    As String

Dim MyCount     As String

Dim MyFileName  As String

Dim MyNewName   As String


'Create instance of Word

Set loWord = New Word.Application


'After this statement, you'll see the Word document instance

loWord.Visible = True


MyCount = 0

MyPathFrom = "E:\TV\"

MyPathTO = "E:\TV\"


'Get the default system printer

lsPrinter = loWord.ActivePrinter


'Now set value in registry - print to PDFWriter

lsVersion = getVersion


MyFileName = Dir(MyPathFrom, vbDirectory)


Do While MyFileName <> ""

    If MyFileName <> "." And MyFileName <> ".." Then

        If (GetAttr(MyPathFrom & MyFileName) And vbNormal) = vbNormal Then

            If LCase(Right(MyFileName, 3)) = "doc" Or LCase(Right(MyFileName, 3)) = "xls" Then

                MyCount = MyCount + 1


                loWord.Documents.Open FileName:=((MyPathFrom) & (MyFileName))

                MyNewName = Left(MyFileName, ((Len(MyFileName) - 4))) & ".pdf"


                If lsVersion = "95/98/ME" Then

                    'This works for Windows 98

                    loWord.System.PrivateProfileString(GetWinDir & "\win.ini", _

                        "Acrobat PDFWriter", "PDFFilename") = MyNewName

                ElseIf lsVersion = "NT/2K/XP" Then

                    'This works for Windows XP

                    Call PrintPDFWinXP(MyNewName)


                    MsgBox "Bad Windows version? May need to update getVersion code"

                    Exit Sub

                End If


                'Print to PDFWriter

                lsPort = loWord.System.PrivateProfileString("", _

                    "HKEY_LOCAL_MACHINE\System\CurrentControlSet\" + _

                    "Control\Print\Printers\Acrobat PDFWriter", "Port")

                loWord.ActivePrinter = "Acrobat PDFWriter on " + lsPort

                loWord.PrintOut Background:=False, Item:=wdPrintDocumentContent


                'Now eliminate value in registry - print to PDFWriter

                If lsVersion = "95/98/ME" Then

                    loWord.System.PrivateProfileString(GetWinDir & "\win.ini", _

                        "Acrobat PDFWriter", "PDFFilename") = ""

                ElseIf lsVersion = "NT/2K/XP" Then

                    Call PrintPDFWinXP("")

                End If




            End If


        End If


    End If


    MyFileName = Dir



MsgBox MyCount & " have been converted."


'Reset system printer

loWord.ActivePrinter = lsPrinter


'Now we can close the Word application entirely


Set loWord = Nothing



End Sub



Public Function getVersion() As String


'This is a very short piece of code


'For a much more complete version,

'see Visual Studio Magazine 05/15/2002,

'Article: Detect Your Windows version by Hank Marquis

'Downloadable from www.visualstudiomagazine.com


   Dim osinfo As OSVERSIONINFO

   Dim retvalue As Integer


   osinfo.dwOSVersionInfoSize = 148

   osinfo.szCSDVersion = Space$(128)

   retvalue = GetVersionExA(osinfo)


   If osinfo.dwPlatformId = 1 Then

       getVersion = "95/98/ME"

   ElseIf osinfo.dwPlatformId = 2 Then

       getVersion = "NT/2K/XP"


       getVersion = "Failed"

   End If


End Function



Private Sub PrintPDFWinXP(ByVal asPath As String)



'Modified from Craig Hambrick post - Acrobat SDK Archive


Dim hKey As Long



    "Software\Adobe\Acrobat PDFWriter", 0, KEY_ALL_ACCESS, hKey)

Call RegSetValueEx(hKey, "PDFFileName", _

    0&, REG_SZ, ByVal asPath, Len(asPath))

Call RegCloseKey(hKey)


End Sub