Enter Date & Time Stamp In PDF File

Did someone asked you to have a date and time stamp on a PDF file? Here’s a page from Adobe that shows how a stamp can be added into a PDF file. This looked nice and easy to me – I can put the system’s date and time onto the PDF file directly without having any code. The complexity increased when my boss asked me to put the date and time stamp of the email from which the PDF file was downloaded.

I searched the internet, found a piece of code in Adobe Support Community’s Using Excel VBA to add text to a PDF file link and taking a look at the Adobe Acrobat’s JavaScript Scripting Reference and Adobe Acrobat’s API Reference PDF files, I found that I can add a Text(box) field object in the PDF file by executing a JavaScript using VBA.

Please note that the code works in Adobe Acrobat DC Pro (not Adobe Reader DC). You need to test in the previous versions of Adobe Acrobat.

Here is the code that I prepared:

Function InsertDateAndTimeStamp(FilePathAndName As String, DateAndTime As Date)
    '   Function/Procedure Name :   InsertDateAndTimeStamp
    '                               Variable Name(s)    Data Type   Description
    '   Variable(s)             :   FilePathAndName     String      PDF Filename Along With Full Path
    '                               DateAndTime         Date        Date & Time To Be Stamped On The First Page Of PDF File
    '   Return Value            :   None
    '   Description             :   This Function/Procedure puts a date and time stamp on the specified PDF file.
    '                               The code runs a JavaScript that creates a textbox field with a message and
    '                               date and time stamp.
    '   Requirements            :   Requires Adobe Acrobat DC (Not Acrobat Reader DC) Application/Software.
    
    Dim objAdobeAcrobat As Object
    Dim objPDFDocument As Object
    Dim objPDFForm As Object
    Dim objViewPDFDocument As Object
    
    Dim objFileSystem As Object
    
    Dim strOriginalFilename As String
    Dim strSaveAsFilename As String
    Dim strTempFolderPath As String
    Dim strPath As String
    Dim strJavaScript As String
        
    Set objAdobeAcrobat = CreateObject("AcroExch.App")          'Adobe Acrobat Application
    Set objPDFDocument = CreateObject("AcroExch.PDDoc")         'PDF Document
    Set objViewPDFDocument = CreateObject("AcroExch.AVDoc")     'PDF Document (View)
    Set objPDFForm = CreateObject("AFormAut.App")               'From AFormAPI
    
    If objViewPDFDocument.Open(FilePathAndName, "") Then
        Set objPDFDocument = objViewPDFDocument.GetPDDoc
        
        'Write JavaScript Code On A VBA Variable
        strJavaScript = "f = this.addField(" & Chr(34) & "ReceivedByDG" & Chr(34) & ", " & _
            Chr(34) & "text" & Chr(34) & ", 0, [250, 25, 20, 0]);" & _
            "f.readonly = true;" & _
            "f.flatten;" & _
            "f.fillColor = color.transparent;" & _
            "f.textSize = 0; " & _
            "f.textFont = font.CourB;" & _
            "f.textColor = color.red;" & _
            "f.strokeColor = color.red;" & _
            "f.multiline = true;" & _
            "f.value = " & _
            Chr(34) & "Received By Dolphin Godfred\n" & _
            "Date & Time: " & Format(DateAndTime, "d-mmm-yyyy hh:mm:ss AM/PM") & Chr(34) & ";"
        
        'Execute The JavaScript Code
        objPDFForm.Fields.ExecuteThisJavaScript strJavaScript
        
        strOriginalFilename = objPDFDocument.GetFileName
        strSaveAsFilename = "TS_" & strOriginalFilename
        strPath = Environ("Temp") & Application.PathSeparator & _
            strSaveAsFilename
        
        Set objFileSystem = CreateObject("Scripting.FileSystemObject")
        If objFileSystem.FileExists(strPath) Then _
            Call objFileSystem.DeleteFile(strPath, True)
        Call objPDFDocument.Save(1, strPath)
        objPDFDocument.Close
        
        objViewPDFDocument.Close 1
    End If
    
    objAdobeAcrobat.CloseAllDocs
    objAdobeAcrobat.Exit
    
    Call objFileSystem.CopyFile(strPath, FilePathAndName, True)
    
    Set objFileSystem = Nothing
    
    Set objPDFForm = Nothing
    Set objViewPDFDocument = Nothing
    Set objPDFDocument = Nothing
    Set objAdobeAcrobat = Nothing
End Function

Merge Two PDF Files – One Of Them Is A Signed File

While I was working with PDF files, I found that the generic code that combines/merges two PDF files fails if one of the PDF file is a Signed Document. I have took the site, wellsr.com code and tested.

Please note that the code works in Adobe Acrobat DC Pro (not Adobe Reader DC). You need to test in the previous versions of Adobe Acrobat.

Here is the code that I modified:

Private Function MergePDFs(SourceFileOne As String, SourceFileTwo As String, SaveAsFilename As String) As Boolean
    '   Function/Procedure Name :   MergePDFs
    '                               Variable Name(s)    Data Type   Description
    '   Variable(s)             :   SourceFileOne       String      PDF Filename Along With Full Path (Source #1 - Signed PDF Document)
    '                               SourceFileTwo       String      PDF Filename Along With Full Path (Source #2)
    '                               SaveAsFilename      String      PDF Filename Along With Full Path To Save (Target)
    '   Return Value            :   Boolean
    '   Description             :   This Function/Procedure merges two PDF files into
    '                               one file and save it at a location set/given by the user.
    '                               Returns True if the merge is successful.
    '                               Returns False if the merge is not successful.
    '   Requirements            :   Requires Adobe Acrobat DC (Not Acrobat Reader DC) Application/Software.
    
    Dim objAdobeAcrobat As Object
    Dim objPDFDocumentOne As Object
    Dim objPDFDocumentTwo As Object
    
    On Error GoTo NoAcrobat
    
    'Initialize the Adobe Acrobat objects
    Set objAdobeAcrobat = CreateObject("AcroExch.App")          'Adobe Acrobat Application
    Set objPDFDocumentOne = CreateObject("AcroExch.PDDoc")      'Destination File
    Set objPDFDocumentTwo = CreateObject("AcroExch.PDDoc")      'Source File
    
    'Open PDF Document Two
    Call objPDFDocumentTwo.Open(SourceFileTwo)
    
    'Open PDF Document One
    Call objPDFDocumentOne.Open(SourceFileOne)
    
    'Merge PDF Document One Into PDF Document Two
    If objPDFDocumentTwo.InsertPages((objPDFDocumentTwo.GetNumPages - 1), _
        objPDFDocumentOne, 0, objPDFDocumentOne.GetNumPages, 0) Then
        MergePDFs = True
    End If
    
    objPDFDocumentOne.Close
    
    'Save PDF Document Two With A New Filename
    Call objPDFDocumentTwo.Save(1, SaveAsFilename)
    objPDFDocumentTwo.Close
    
    objAdobeAcrobat.CloseAllDocs
    objAdobeAcrobat.Exit
    
NoAcrobat:
    
    On Error GoTo 0
    
    Set objPDFDocumentTwo = Nothing
    Set objPDFDocumentOne = Nothing
    Set objAdobeAcrobat = Nothing

End Function

Excerpts of my writing in one of the groups in Facebook

This is my writing in one of the groups (Excel VBA codes and Macros) in Facebook. You can find the excerpt here.

My training was different. I initially learnt VB6 and then moved into VBA when I started my career. Trust me while I say this: I had to struggle to understand the way VBA works as opposed to VB6. Since I learnt VB6, it was somewhat easy to work with VBA. It is only the logical thinking and the Basic Foundations that made me strong in this. And if you ask me any theoretical question, I may not be able to answer. But deep down, I know I can get a solution to a problem. When I write a code, I always say that it (the code) is not a perfect code, but the best code. You always need to find time to revisit your old code and try to modify them more to your requirement. Let me tell you my motto – “Why work, when the system can work for you?” With this statement, you can understand what kind of a man I am. Let me be bold to say this: “Yes, I am LAZY!” By this, I started automating my regular chores at my office. Above all, Practice. This makes you perfect. It is not that you just learn or read about something or some function in VBA and just leave it off! You need to start thinking how you could use it and how you could modify it for your requirement. If you don’t get a solution, break your problem into pieces and try to solve them one-by-one. At the end, you’ll get your solution. I also say this, make sure you have more than one (many) way(s) to solve your problem. Because, if one way fails, you have the other ways. No book or website(s) will help you to be great. It’s your logical thinking and practice that makes you good (not perfect!). Internet is a great resource. But not “The Resource”. Use it for your requirement. Modify the code per your requirement. Remember there may not be any direct resolutions found on internet for your problem. You will get your solutions in bits and pieces. Merge them to get your solution. I tell this to everyone who think they can come into limelight once they learn VBA. But that’s not true. You have to fight/struggle with the system. You have to show the system that you are the best. And, in order to be the best, you should prove yourself (again and again). I am not a theoretical person. I am practical. I love what I do and I live for it. I know there are few people who teach VBA for people to learn. But most of the times, I’ve seen faculties teach VBA just for money. They do not care if people have learnt or not. I feel sad and sick about this. But hoping one day we will find some people who will teach wholeheartedly VBA where the rest of the world will learn and excel in this beautiful programing language, VBA.

You need not get recognized by the management. Once you are well known with your peers and colleagues, you are automatically in the limelight, whether your managers/seniors recognize you or not. Word of mouth spreads faster than emails and recognitions. (Don’t look for recognitions, you are here to learn. Every new thing is a learning for you. If you start looking for recognitions, you are deviating from your path.) Chances are that even people from other processes come and ask for your help.

Don’t learn VBA as a stepping stone to next level of your career. I’ve seen people just doing that. Once you move to the next level, you will not look into VBA anymore. Because, your next level job will have more work than you have in your current level. Probably, you may have time in the beginning. But, later, you’d not. It’s very rare to find a person who’s still continuing to work with VBA and in management level. Let me tell you my story. I am still an associate (since 2000! Now, can you believe that!?). I did not want to move into management role because I believed that if I make that move, I’d lose my grip on VBA. And, guess what? That paid off! I had chance to work with different applications in different organizations. And, I am proud of that. I don’t want to block your career, it’s entirely in your hands.

A few things to remember while entangling yourself in corporate politics:
• Make sure you are constantly in touch with your manager about what you are doing.
• Whatever work you are doing, make sure that it is in on papers and your management is agreeing for it. If not, it is better not to take up. Let someone else take it.
• Make sure the work you did and the talent you have is recognized by the management.
• Remember, nothing is for free. You do something, you get recognized for that.
• Don’t go for someone else’s idea. If the idea is already done and implemented, think which way you can improve it. Trust me, nobody likes negatives on their project. So, use your words wisely to make them understand what improvements you want to have in their project. Also, indulge yourself in the project so that your feedback is also taken and implemented.
• Your idea should be new and innovative, just like the “Hatt ke” types. Your thoughts should be different from others. Your coding skills must be way above than the ones who are presently writing codes. People should say, “Yes, this is what we are looking for”.
• Become a redeemer for your process. Be with them when they need you. They should look at you if they need any automation. Doesn’t it sound nice when you and your team does something without anybody’s help and present it to the management? (Team work is important too!)

Above all, PATIENCE, my friend, Patience! That will take you to a lot of places. Learn patiently, you have your days. Remember the saying: “Every dog has its day!” and the famous dialog in 3 Idiots “Success ke peeche mat bhago. Kabil bano. Success toh jhak marke ayegi!” (Translation for others who didn’t understand: Don’t run behind success. Try to achieve excellence. Success will come looking for you.) It may sound like as if I am a fool. But, trust me, people who worked with me know what I am.

One last thing. BE UNIQUE! People will try to copy your codes. That’s ok (it’s natural!). They are copying from you. Infact, you are giving your codes for their work. Be happy! Though they might not tell you, others know whose codes they are. I also faced this problem. But a manager of mine once told me this: “You are Black Cat. The rest are Copy Cats. You are unique.” That’s true, I’m unique. My coding style is different from others. Everybody knows who I am and what I am capable of. So, my dear people, never worry for anything. You are learning VBA to enjoy! Not to sit and cry.

Connection String!? What? How?

I understand most of you are programmers and will need connection strings to get connected to Databases/Servers. While it’s tough to remember/write connection strings, there’s a site that gives you all the connection strings that are required.

Here’s the link:https://www.connectionstrings.com/

Get Default Mail Client

Are your clients/co-workers work on Mail Clients (Microsoft Outlook, Outlook Express or Lotus Notes)?
Don’t worry, you can know their mail client with this simple code below:

Function CheckDefaultMailClient() As String
    'Reads the value for the default email client from Registry
    'If the key cannot be found, the return value is ""

    Dim objWindowsScript As Object
    Dim strDefaultMailClient As String
    Dim strRegistryKey As String

    strRegistryKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Clients\Mail\"

    On Error Resume Next
    'Access Windows scripting
    Set objWindowsScript = CreateObject("WScript.Shell")
    'Read key from registry
    strDefaultMailClient = objWindowsScript.RegRead(strRegistryKey)

    If strDefaultMailClient = vbNullString Or strDefaultMailClient = "" Then
        CheckDefaultMailClient = ""
    Else
        CheckDefaultMailClient = strDefaultMailClient
    End If
End Function

Get FileType And Executable File Path Of A File

Ever wondered if you needed the FileType and Executable File Path of a particular file? Well, I had to. So, I started to look into my famous, all time (24 X 7) library – internet. And found out that I can use the FileSystemObject and an API declaration to finish my work. So, here it goes.

For FileType, I used FileSystemObject and File object. And, for Executable File Path, I declared an API Function, FindExecutable using shell.dll library.

Here goes the code:

Private Declare Function FindExecutable Lib “shell32.dll” Alias “FindExecutableA” _
    (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long

Sub Check()
    Dim strExecutableProgramPath As String
    Dim strFilePathAndName As String, strFileType As String
    Dim objFileSystem As Object, objFile As Object
    
    'Create FileSystemObject
    Set objFileSystem = CreateObject(“Scripting.FileSystemObject”)
    strFilePathAndName = Worksheets(“Sheet1”).Range(“B1”).Value
    
    'Create File object and get FileType
    Set objFile = objFileSystem.GetFile(strFilePathAndName)
    strFileType = objFile.Type
    
    strExecutableProgramPath = FindExecutableProgram(strFilePathAndName)
    
    Worksheets(“Sheet1”).Range(“B2”).Value = strFileType
    Worksheets(“Sheet1”).Range(“B3”).Value = strExecutableProgramPath
    
    Set objFile = Nothing
    Set objFileSystem = Nothing
End Sub

Private Function FindExecutableProgram(FilePathAndNameWithExtension As String) As String
    Dim lngReturnValue As Long
    Dim strBuffer As String
    
    strBuffer = Space(260)
    
    'FindExecutable:
    'Retrieve the name and handle of the executable, associated with this file
    'Returns a value greater than 32 if successful.
    'Or a value less than or equal to 32 representing an error.
    'Return Value/Code Description
    '2 SE_ERR_FNF The specified file was not found.
    '3 SE_ERR_PNF The specified path is invalid.
    '5 SE_ERR_ACCESSDENIED The specified file cannot be accessed.
    '8 SE_ERR_OOM The system is out of memory or resources.
    '31 SE_ERR_NOASSOC There is no association for the specified file type with an executable file.
    
    lngReturnValue = FindExecutable(FilePathAndNameWithExtension, vbNullString, strBuffer)
    If lngReturnValue > 32 Then
        FindExecutableProgram = Left$(strBuffer, InStr(strBuffer, Chr$(0)) – 1)
    Else
        FindExecutableProgram = “No association found!”
    End If
End Function

Get Column Letter From Column Number

To get the Letter of a column, there are two ways.

#1 (Simplest way, I think):

Function GetColumnLetter(ColumnNumber As Long) As String
    GetColumnLetter = Split(Columns(ColumnNumber).Address(), “$”)(2)
End Function

#2:

Function GetColumnLetter(ByVal ColumnNumber As Long, _
  Optional ColumnName As String = “”) As String
    If ColumnNumber = 0 Then
        GetColumnLetter = ColumnName
    Else
        ColumnName = Chr(65 + (ColumnNumber – 1) Mod 26) & ColumnName
        ColumnNumber = (ColumnNumber – 1) \ 26
        GetColumnLetter = GetColumnLetter(ColumnNumber, ColumnName)
    End If
End Function

Find The Active Last Column Number

The below code should work in all versions of Excel (if not, please let me know):

Function GetColumnCount(WorksheetName As String, RowNumber As Long) As Long
    With Worksheets(WorksheetName)
        GetColumnCount = .Cells(RowNumber, .Columns.Count).End(xlToLeft).Column
    End With
End Function

Find The Active Last Row Number

The below code should work in all versions of Excel (if not, please let me know):

Function GetRowCount(WorksheetName As String, ColumnNumber As Long) As Long
    With Worksheets(WorksheetName)
        GetRowCount = .Cells(.Rows.Count, ColumnNumber).End(xlUp).Row
    End With
End Function

FileSystemObject

Today, let’s try the FileSystemObject.

What is FileSystemObject?
The FileSystemObject, or FSO, is an often used component to access the file system. For example, you can create files, read the contents of files, determine whether or not a folder or file exists, iterate through the contents of a folder or directory, or any other number of file system-related tasks.

FileSystemObject can be found in Scrrun.dll. In addition to FileSystemOject, Scrrun.dll includes four other objects available for File I/O and other tasks. These objects include the File object, the TextStreamObject object, the Folder object, and the Drive object. We will concentrate on FileSystemObject.

Public Sub CreateFolder()
    'Create a folder using FileSystemObject
    Dim objFileSystemObject As Scripting.FileSystemObject
    Dim FolderPath As String, FolderNameToCreate As String, FullPath As String

    'Get the folder path and folder name to create
    FolderPath = Sheets(“Create”).Range(“B1”).Value
    FolderNameToCreate = Sheets(“Create”).Range(“B2”).Value

    'Create FileSystemObject object
    Set objFileSystemObject = New Scripting.FileSystemObject

    'Check if “\” (backslash) is available at the end of the folder path and add if it’s not there
    If Right(FolderPath, 1) <> “\” Then FolderPath = FolderPath & “\”

    If Not objFileSystemObject.FolderExists(FolderPath) Then
        'If the folder path does not exist
        MsgBox “The folder, ” & FolderPath & ” does not exist.”, _
            vbOKOnly, “Create Folder Using FSO”
        Exit Sub
    End If

    FullPath = FolderPath & FolderNameToCreate

    If Not objFileSystemObject.FolderExists(FullPath) Then
        'If the folder to create does not exist, create the folder
        Call objFileSystemObject.CreateFolder(FullPath)
    Else
        'If the folder to create exists
        MsgBox “The folder, ” & FolderNameToCreate & ” already exists!”, _
            vbOKOnly, “Create Folder Using FSO”
    End If

    Set objFileSystemObject = Nothing
End Sub

Public Sub CopyFolder()
    'Copy a folder using FileSystemObject
    Dim objFileSystemObject As Scripting.FileSystemObject
    Dim SourceFilePath As String, DestinationFilePath As String

    'Get source folder and target folder names
    SourceFilePath = Sheets(“Copy”).Range(“B1”).Value
    DestinationFilePath = Sheets(“Copy”).Range(“B2”).Value

    'Check if “\” (backslash) is available at the end of the folder path and remove if it’s there
    If Right(SourceFilePath, 1) = “\” Then _
        SourceFilePath = Left(SourceFilePath, (Len(SourceFilePath) – 1))

    'Check if “\” (backslash) is available at the end of the folder path and remove if it’s there
    If Right(DestinationFilePath, 1) = “\” Then _
        DestinationFilePath = Left(DestinationFilePath, (Len(DestinationFilePath) – 1))

    'Create FileSystemObject object
    Set objFileSystemObject = New Scripting.FileSystemObject

    If Not objFileSystemObject.FolderExists(SourceFilePath) Then
        'If source folder does not exist
        MsgBox “The folder, ” & SourceFilePath & ” does not exist.”, _
            vbOKOnly, “Copy Folder Using FSO”

        Exit Sub
    End If

    If Not objFileSystemObject.FolderExists(DestinationFilePath) Then
        'If destination folder does not exist
        objFileSystemObject.CopyFolder SourceFilePath, DestinationFilePath
    Else
        'If destination folder exists
        MsgBox “The folder, ” & DestinationFilePath & ” already exists!”, _
            vbOKOnly, “Copy Folder Using FSO”
    End If

    Set objFileSystemObject = Nothing
End Sub

Public Sub MoveFolder()
    'Move a folder using FileSystemObject (moving and renaimg a folder)
    Dim objFileSystemObject As Scripting.FileSystemObject
    Dim SourceFilePath As String, DestinationFilePath As String

    'Get source folder and target folder names
    SourceFilePath = Sheets(“Move”).Range(“B1”).Value
    DestinationFilePath = Sheets(“Move”).Range(“B2”).Value

    'Check if “\” (backslash) is available at the end of the folder path and remove if it’s there
    If Right(SourceFilePath, 1) = “\” Then _
        SourceFilePath = Left(SourceFilePath, (Len(SourceFilePath) – 1))

    'Check if “\” (backslash) is available at the end of the folder path and remove if it’s there
    If Right(DestinationFilePath, 1) = “\” Then _
        DestinationFilePath = Left(DestinationFilePath, (Len(DestinationFilePath) – 1))

    'Create FileSystemObject object
    Set objFileSystemObject = New Scripting.FileSystemObject

    If Not objFileSystemObject.FolderExists(SourceFilePath) Then
        'If source folder does not exist
        MsgBox “The folder, ” & SourceFilePath & ” does not exist.”, _
            vbOKOnly, “Move Folder Using FSO”
        Exit Sub
    End If

    If Not objFileSystemObject.FolderExists(DestinationFilePath) Then
        'If destination folder does not exist, move the folder
        objFileSystemObject.MoveFolder SourceFilePath, DestinationFilePath
    Else
        'If destination folder exists
        MsgBox “The folder, ” & DestinationFilePath & ” already exists!”, _
            vbOKOnly, “Move Folder Using FSO”
    End If

    Set objFileSystemObject = Nothing
End Sub

Public Sub DeleteFolder()
    'Delete a folder using FileSystemObject
    Dim objFileSystemObject As Scripting.FileSystemObject
    Dim RemoveFolderPath As String

    'Get folder path to Delete
    RemoveFolderPath = Sheets(“Delete”).Range(“B1”).Value

    'Check if “\” (backslash) is available at the end of the folder path and remove if it’s there
    If Right(RemoveFolderPath, 1) = “\” Then _
        RemoveFolderPath = Left(RemoveFolderPath, (Len(RemoveFolderPath) – 1))

    'Create FileSystemObject object
    Set objFileSystemObject = New Scripting.FileSystemObject

    If objFileSystemObject.FolderExists(RemoveFolderPath) Then
        'If the folder exists, delete the folder
        objFileSystemObject.DeleteFolder RemoveFolderPath, True
    Else
        'If folder does not exist
        MsgBox “The folder, ” & RemoveFolderPath & ” does not exist.”, _
            vbOKOnly, “Move Folder Using FSO”
    End If

    Set objFileSystemObject = Nothing
End Sub