VBA Script - Add Header - Save as PDF

[chrisx0x]

Guys
Firstly thank you in advance for the help!

Id like to make a small vba script on my desktop which
- Opens up the Select File dialog box
- Select a word document
- Add a JPG in the header [my company's logo basically]
- Safe as PDF in same folder as word

Could anyone help!


Thanks
Chris

[Guessed]

Do you mean a vbscript? Do you specifically want the file picker or would it be better if you could drag a Word document on top of the script to 'pass in the filename' variable?

Which header does the logo go in to? (Section 1 first page, main or even?) Is there other content in that header that has to remain? This will be easiest if your entire header or logo is saved in the Normal template as a building block.

[chrisx0x]

hey guessed
thanks for coming back on this. appreciate it.

answers to your q's:
- yes; apologies, i meant a vbscript
- that would also work too. but i thought of it as a small standalone app that resides on the desktop.
- header on first page only
- no, header in all documents is empty. script should just dump the 'logo.jpg' in header (and print as pdf)
- i just want the logo embedded in the PDF file only. In word, i want to be able to print the document onto A4 that already has our logo on it

Many thanks
Chris

[gmayor]

The following should work. Open a document in Word and run the macro Installing Macros

Don't forget to change the path in the macro to the location where the logo is saved.

The process assumes that the logo is in the centre of the first page header.

Sub LogoAndPDF()

'Graham Mayor - https://www.gmayor.com - Last updated - 18 Nov 2019
Dim oHeader As Range
Dim strDocName As String
Dim intPos As Integer
Const strLogo As String = "C:\Path\Logo.jpg"    'substitute path of logo
Start:
    strDocName = ActiveDocument.FullName
    intPos = InStrRev(strDocName, ".")
    If intPos = 0 Then
        ActiveDocument.Save
        GoTo Start
    End If
    strDocName = Left(strDocName, intPos - 1)
    ActiveDocument.Sections(1).PageSetup.DifferentFirstPageHeaderFooter = True
    Set oHeader = ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range
    oHeader.End = oHeader.End - 1
    oHeader.InlineShapes.AddPicture FileName:=strLogo
    oHeader.ParagraphFormat.Alignment = wdAlignParagraphCenter

    ActiveDocument.ExportAsFixedFormat OutputFilename:=strDocName, _
                                       ExportFormat:=wdExportFormatPDF, _
                                       OpenAfterExport:=False, _
                                       OptimizeFor:=wdExportOptimizeForPrint, _
                                       Range:=wdExportAllDocument, from:=1, to:=1, _
                                       Item:=wdExportDocumentContent, _
                                       IncludeDocProps:=True, _
                                       KeepIRM:=True, _
                                       CreateBookmarks:=wdExportCreateHeadingBookmarks, _
                                       DocStructureTags:=True, _
                                       BitmapMissingFonts:=True, _
                                       UseISO19005_1:=False
    ActiveDocument.Close SaveChanges:=False
lbl_Exit:
    Set oHeader = Nothing
    Exit Sub
End Sub

[Guessed]

As a VBScript, the following should be saved into a text file and given a name that ends with ".vbs". Make sure you provide a valid path to the logo up the top.

Dim sLogo, objArgs, objFSO, objWord, I

sLogo = "C:\Path\Logo.jpg"    'substitute path to your logo

Set objArgs = WScript.Arguments
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objArgs.Count = 0 then
	wScript.Echo "You need to drop Word documents onto this script!"
Else
	Set objWord = CreateObject("Word.Application")
	objWord.Visible = True
	For I = 0 to objArgs.Count - 1
		LogoAndPDF objArgs(I)
	Next
	objWord.Quit
End If

Function LogoAndPDF(sFilePath)
  Dim sFolder, sBaseName, sExt, sPDF, oDoc, oRng
  sFolder = objFSO.GetParentFolderName(sFilePath) & "\"
  sBaseName = objFSO.GetBaseName(sFilePath)
  sExt = objFSO.GetExtensionName(sFilePath)
  sPDF = sFolder & sBaseName & ".pdf"
  Select Case sExt
	Case "doc", "docx", "docm"
		Set oDoc = objWord.Documents.Open(sFilePath)
		oDoc.Sections(1).PageSetup.DifferentFirstPageHeaderFooter = True
		Set oRng = oDoc.Sections(1).Headers(2).Range
		oRng.Text = ""
		oRng.InlineShapes.AddPicture sLogo
		oRng.ParagraphFormat.Alignment = 1		'wdAlignParagraphCenter
		oDoc.ExportAsFixedFormat sPDF, 17		'wdExportFormatPDF
		oDoc.Close False
  End Select
End Function

To run the script in Windows File Explorer, drag one or more Word documents onto the file. It will create PDFs in the same folder as the source documents.

[chrisx0x]

Andrew, Graham - you are amazing. Both scripts work beautifully.
Im speechless. This will save me hours of manual work.
Thank you guys so much. I wish there was a way to repay you. (if there is, please let me know!)
Thank you again
Chris

[chrisx0x]

Graham - Just made a small donation through your website. Thanks v much.

Andrew - Let me know how I can donate.

Originally Posted by gmayor

The following should work. Open a document in Word and run the macro Installing Macros

Don't forget to change the path in the macro to the location where the logo is saved.

The process assumes that the logo is in the centre of the first page header.

Sub LogoAndPDF()

'Graham Mayor - https://www.gmayor.com - Last updated - 18 Nov 2019
Dim oHeader As Range
Dim strDocName As String
Dim intPos As Integer
Const strLogo As String = "C:\Path\Logo.jpg"    'substitute path of logo
Start:
    strDocName = ActiveDocument.FullName
    intPos = InStrRev(strDocName, ".")
    If intPos = 0 Then
        ActiveDocument.Save
        GoTo Start
    End If
    strDocName = Left(strDocName, intPos - 1)
    ActiveDocument.Sections(1).PageSetup.DifferentFirstPageHeaderFooter = True
    Set oHeader = ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range
    oHeader.End = oHeader.End - 1
    oHeader.InlineShapes.AddPicture FileName:=strLogo
    oHeader.ParagraphFormat.Alignment = wdAlignParagraphCenter

    ActiveDocument.ExportAsFixedFormat OutputFilename:=strDocName, _
                                       ExportFormat:=wdExportFormatPDF, _
                                       OpenAfterExport:=False, _
                                       OptimizeFor:=wdExportOptimizeForPrint, _
                                       Range:=wdExportAllDocument, from:=1, to:=1, _
                                       Item:=wdExportDocumentContent, _
                                       IncludeDocProps:=True, _
                                       KeepIRM:=True, _
                                       CreateBookmarks:=wdExportCreateHeadingBookmarks, _
                                       DocStructureTags:=True, _
                                       BitmapMissingFonts:=True, _
                                       UseISO19005_1:=False
    ActiveDocument.Close SaveChanges:=False
lbl_Exit:
    Set oHeader = Nothing
    Exit Sub
End Sub

[chrisx0x]

Graham you seem to be based not very far from where I am About a 1 hour drive from Nicosia!