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

Public Type OSVERSIONINFO

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)

Else

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

loWord.ActiveDocument.Close

Else

End If

Else

End If

Else

End If

MyFileName = Dir

Loop

MsgBox MyCount & " have been converted."

'Reset system printer

loWord.ActivePrinter = lsPrinter

'Now we can close the Word application entirely

loWord.Quit

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"

Else

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

Call RegOpenKeyEx(HKEY_CURRENT_USER, _

"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