VBA Is it possible to open and print a text file to pdf?

[dreid1011]

Good morning,

I am trying to make a few processes at work a bit more efficient. One of them requires me to print a set of text files to pdf. Right now, I can do it one of two ways:

Open each file and print to pdf one at a time.

or

Change my default printer to the pdf printer and right click + print each text file one at a time.

I've been poking around, but so far I have come up empty. I can open the files as TextStream objects, but can I print them?

Thank you,

 

[John_w]

You could import one of the text files into a blank sheet (Data tab -> From text) then save the sheet as a PDF. Record these steps with the macro recorder and add a Dir function loop which loops through all text files in the folder and with a few other changes you'll have a macro which creates a PDF for each text file.

 

[John_w]

Actually, it might be easier to open the text file from Excel (File -> Open), rather than importing it.

 

[dreid1011]

That may work so long as it doesn't keep converting some numbers to scientific notation.

Edit: Nvm, I can fix that but to do it automatically. I suppose I should record some macros now. Thank you.

Edit:

Workbooks.OpenText Filename:= _
        "... filepath ...", Origin _
        :=437, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 2), _
        Array(36, 2), Array(61, 2), Array(92, 2), Array(97, 2), Array(114, 2), Array(119, 2), Array _
        (131, 2), Array(139, 2), Array(154, 2)), TrailingMinusNumbers:=True

I'm not sure how to interpret everything after "Origin". I went through the import wizard manually and changed all the column data types to Text to avoid the issue. But, I don't know what part of the above code is doing that. Any thoughts?

 

[dreid1011]

Edit: Nvm, again. Just need to play with it some more. The array elements are referencing the "fixed width" starting position of each column and the second is the option I select for formatting. 1= General, 2= Text, 3= Date, etc. Though the positions are not exactly the same each time.

 

[dreid1011]

Maybe I'll keep looking. This method could work, but it would be more trouble than it's worth to make it print the same as printing directly from the text document. The lines are longer than the width of the page, and notepad automatically wraps each line individually. Excel does not. Oh well.

 

[Domenic]

Do you have Microsoft Word? If so, you can use Word to create PDF files, instead of Excel. As John has already suggested, you can use Dir to loop through all text files in the folder. Then you can open each one in Word, export the document as a PDF file, and then close the document.

If this is something that you would be interested in and you need help, post back.

 

[dreid1011]

Do you have Microsoft Word? If so, you can use Word to create PDF files, instead of Excel. As John has already suggested, you can use Dir to loop through all text files in the folder. Then you can open each one in Word, export the document as a PDF file, and then close the document.

If this is something that you would be interested in and you need help, post back.

I don't necessarily need help with how to do it, but with an unexpected result of the doing.

Code so far:

Private Sub PrintToPDF()
Dim oFile As Object
Dim oFSO As Object
Dim oFolder As Object
Dim oF As Object
Dim tPath As String

tPath = "W:\TaxPgms\DataFolder\POINT AND PAY UPLOAD FILES\"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(tPath)
For Each oFile In oFolder.Files
    If Right(oFile.Name, 4) = ".txt" Then
        Documents.Open FileName:=tPath & oFile.Name
        With ActiveDocument.PageSetup
            .TopMargin = InchesToPoints(0.5)
            .BottomMargin = InchesToPoints(0.5)
            .LeftMargin = InchesToPoints(0.5)
            .RightMargin = InchesToPoints(0.5)
        End With
    End If
Next
End Sub

I am testing with 3 text files, but a fourth file is being opened containing my name and a bunch of gibberish. I tried a piece of code using Dir and looping while the file name was not blank, but that seemed to create an endless loop and locked up Word.

This is more or less the code I was using when that occurred:

Sub DoVBRoutineNow()
Dim file
Dim path As String


path = "C:\Documents and Settings\userName\My Documents\myWorkFolder\"

file = Dir(path & "*.doc")
Do While file <> ""
Documents.Open FileName:=path & file

Loop
End Sub

 

[Domenic]

You'll need to get the next file by calling the Dir function within your Do While/Loop...

[COLOR=#333333]Sub DoVBRoutineNow()
[/COLOR]Dim file
Dim path As String


path = "C:\Documents and Settings\userName\My Documents\myWorkFolder\"

file = Dir(path & "*.doc")
Do While file <> ""
Documents.Open FileName:=path & file
[COLOR=#ff0000]file = Dir[/COLOR]
Loop 
[COLOR=#333333]End Sub[/COLOR]

 

[dreid1011]

Thank you for that. Here is the end result:

Private Sub PNPPrintToPDF()
Dim tFile As Variant
Dim tPathIn As String
Dim tPathOut As String
Dim tNewName As String
Dim tSingleWord As Range

tPathIn = " … "
tPathOut = " … "

tFile = Dir(tPathIn & "*.txt")

Do While tFile <> ""
    Documents.Open FileName:=tPathIn & tFile
    With ActiveDocument
        With .PageSetup
            .LeftMargin = InchesToPoints(0.5)
            .RightMargin = InchesToPoints(0.5)
        End With
        tNewName = "pnp" & Mid(.Name, 18, 4) & Mid(.Name, 14, 4)
        With .Sections.Item(1).Headers(wdHeaderFooterPrimary).Range
            .Text = ActiveDocument.Name
            .Paragraphs.Alignment = wdAlignParagraphCenter
            .Font.Name = "Consolas"
        End With
        For Each tSingleWord In .Words
            If tSingleWord.Font.Name <> "Consolas" Then
                tSingleWord.Font.Name = "Consolas"
                tSingleWord.Font.Size = 11
            End If
        Next
        .ExportAsFixedFormat OutputFileName:=tPathOut & tNewName & ".pdf", ExportFormat:=wdExportFormatPDF
        Word.ActiveDocument.Saved = True
        .Close
    End With
    tFile = Dir
Loop
End Sub