How to convert a text file to PDF using VBA?

Viewed 126

I want to convert a list of text files in a particular folder into PDF.

I have written logic to open a single text file from Word document to be saved in a PDF format but it is not saved as a PDF file.

This is Excel VBA.

Dim file As Variant
inp_dir = "C:\Users\HP\OneDrive\Desktop\vbatest\pdfconv\"
inp_file_name = Dir(inp_dir & "*.txt") 'txt path
inp_file = inp_dir & inp_file_name

Dim wdApp As New Word.Application, wdDoc As Word.Document

MsgBox (inp_file)

' Set wdDoc = Documents.Open(inp_file)
Set wdDoc = Documents.Open(Filename:=inp_file, ReadOnly:=True, _
  AddToRecentFiles:=False, Format:=wdOpenFormatAuto, Visible:=False)
  
wdDoc.SaveAs2 Filename:="inp_file" & Replace(inp_file, ".txt", ".pdf"), _
  FileFormat:=wdFormatPDF, AddToRecentFiles:=False
wdDoc.Close False
2 Answers

I guess you are close - you just have a small mistake in your destination file name: You write Filename:="inp_file" & Replace(inp_file, ".txt", ".pdf"), but the fixed string "inp_file" makes no sense and invalidates the filename.

I always advice to use intermediate variables, with that it gets much easier to debug and to find errors.

Some more small things:

  • You should use Option Explicit and declare all variables.
  • You have a variable file declared that is never used.
  • declare your path as Constant

Your code could look like:

Const inp_dir = "C:\Users\HP\OneDrive\Desktop\vbatest\pdfconv\"

Dim inp_file_name As String, inp_full_name As String

inp_file_name = Dir(inp_dir & "*.txt") 'txt path
inp_full_name = inp_dir & inp_file_name

Dim wdApp As New Word.Application, wdDoc As Word.Document
Set wdDoc = wdApp.Documents.Open(Filename:=inp_full_name, ReadOnly:=True, _
    AddToRecentFiles:=False, Format:=wdOpenFormatAuto, Visible:=False)
  
Dim pdf_Filename As String
pdf_Filename = Replace(inp_full_name, ".txt", ".pdf")
Debug.Print pdf_Filename 
wdDoc.SaveAs2 Filename:=pdf_Filename, FileFormat:=wdFormatPDF, AddToRecentFiles:=False
wdDoc.Close False

wdApp.Quit

Your code is very close to running. Basically you need to open Word using your wdApp object. This example shows how...

Option Explicit

Sub TxtToPDF()
    Dim inp_dir As String
    Dim inp_file_name As String
    Dim inp_file As String
    inp_dir = "C:\Temp\"
    inp_file_name = Dir(inp_dir & "*.txt")       'txt path
    
    Dim wordWasRunning As Boolean
    wordWasRunning = IsMSWordRunning
    
    Dim wdApp As Word.Application
    Set wdApp = AttachToMSWordApplication
    
    Do While Len(inp_file_name) > 0
        inp_file = inp_dir & inp_file_name
        Debug.Print "currently opening " & inp_file

        Dim wdDoc As Word.Document
        Set wdDoc = wdApp.Documents.Open(Filename:=inp_file, _
                                         ReadOnly:=True, _
                                         AddToRecentFiles:=False, _
                                         Format:=wdOpenFormatAuto, _
                                         Visible:=False)
        Dim out_file As String
        out_file = Replace(inp_file, ".txt", ".pdf")
        Debug.Print "saving as " & out_file
        wdDoc.SaveAs2 Filename:=out_file, _
                      FileFormat:=wdFormatPDF, AddToRecentFiles:=False
        wdDoc.Close False
        
        '--- get the next txt file
        inp_file_name = Dir
    Loop
    
    If Not wordWasRunning Then
        wdApp.Quit
    End If
End Sub

Put this code in another module to use (from my personal library).

Option Explicit

Public Function IsMSWordRunning() As Boolean
    '--- quick check to see if an instance of MS Word is running
    Dim msApp As Object
    On Error Resume Next
    Set msApp = GetObject(, "Word.Application")
    If Err > 0 Then
        '--- not running
        IsMSWordRunning = False
    Else
        '--- running
        IsMSWordRunning = True
    End If
End Function

Public Function AttachToMSWordApplication() As Word.Application
    '--- finds an existing and running instance of MS Word, or starts
    '    the application if one is not already running
    Dim msApp As Word.Application
    On Error Resume Next
    Set msApp = GetObject(, "Word.Application")
    If Err > 0 Then
        '--- we have to start one
        '    an exception will be raised if the application is not installed
        Set msApp = CreateObject("Word.Application")
    End If
    Set AttachToMSWordApplication = msApp
End Function
Related