How to Extract Wild Card Matches in Word Document using Word VBA / Export Find Matches to Text File using VBA

How to use Word VBA to Find Wild Card Matches in Multiple Word Documents and Extract them 

There are many situations where a particular format throughout the document that needs to be extracted. The answer would be 

1) Wild Card Search
2) Regular expressions

Lets consider wild card search for this post for a document that contains Reference Citations within square brackets [...]

The following snippet Loops through all documents in a folder, opens them and searches for content within Square Brackets 

It exports the matches to a Text File (Can store in Excel also)


Sub Extract_WildCard_Matches()

Dim sWildCard As String
Dim sDir
Dim oWD As Word.Document
Dim sPath As String


sWildCard = "\[[!\[\]]{1,}\]"

sPath = "C:\Documents\"
sDir = Dir$(sPath & "*.docx", vbNormal)

Do Until LenB(sDir) = 0

 Set oWD = Documents.Open(sPath & sDir)

    Open "C:\Match_Output.txt" For Append As #1
    
        Selection.HomeKey wdStory, wdMove
        
        Selection.Find.Execute FindText:=sWildCard, MatchWildcards:=True
        
        Do While Selection.Find.Found
            
            Print #1, ActiveDocument.Name & vbTab & Selection.Range.Text
            
            Selection.Range.Collapse wdCollapseEnd
            
            Selection.Find.Execute
        Loop
        
    Close #1

 oWD.Close False

 sDir = Dir$

Loop




End Sub

How to Login to a HTTPS Website PopUp using Excel VBA

Control Login Popup from Excel VBA 

The new HTTPS popups cause lot of irritation to the developers who have coded for it before.


I have tried to circumvent it using SendKeys. Please have a look at the snippet below and share your views on it



 
     Set ie = CreateObject("InternetExplorer.Application.1")
            ie.Visible = True
            ie.navigate cURL
             
             Application.Wait (Now + TimeValue("0:00:10"))
            If ie.readyState = READYSTATE_LOADING Then
         
              Set objShellWindows = New ShellWindows

            Application.SendKeys "abcd"
            Application.SendKeys "{TAB}"
            Application.SendKeys "pwd123"
            Application.SendKeys "{TAB}"
            Application.SendKeys "{RETURN}"
           
            End If
             
        'Do While ie.Busy: DoEvents: Loop
          Set doc = ie.Document

Convert PowerPoint TextBox Slides as Notes using VBA

How to Add Notes to Powerpoint Slides using VBA


It has been quite some time since I posted in this blog. Murugan had kindled that in the form of the following snippet. We are had earlier tried Creating PowerPoint Presentation through VBA and Save PowerPoint Presentation as PDF using VBA

This snippet converts the TextBoxes / Shapes with Text that are available in PowerPoint Slide to Notes Section.

Sub Export_TextBoxes_AsNotes()
    
    Dim oPPT As Presentation
    Dim oSlide As Slide
    Dim oSlideShape As Shape
    Dim oNotesShape As Shape
    
    Set oPPT = ActivePresentation
    Set oSlide = oPPT.Slides(3)
    
    For Each oSlideShape In oSlide.Shapes
        
        If oSlideShape.HasTextFrame Then
        
            Set oNotesShape = oSlide.NotesPage.Shapes.AddShape(msoShapeRectangle, 54, 442, 432, 324) '
            oNotesShape.TextFrame.TextRange.Text = oSlideShape.TextFrame.TextRange.Text
        
        End If
    
    Next
    
    If Not oSlide Is Nothing Then Set oSlide = Nothing
    If Not oPPT Is Nothing Then Set oPPT = Nothing
    

End Sub

See also:
Delete End Points from List using Powerpoint VBA
How to Save PowerPoint Presentation as PDF using VBA

How to Save PowerPoint Presentation as PDF using VBA

How to Convert PowerPoint Presentation PPT to PDF using VBA

PDF is always the universal format for sending the files. With lot of versions of MS Office and other Office suites around .. it is better to circulate the Deck as a PDF

The following snippet converts the Presentation to a PDF and saves in the same folder of the PPT

ActivePresentation.ExportAsFixedFormat ActivePresentation.Path & "\" & ActivePresentation.Name & ".pdf", ppFixedFormatTypePDF, ppFixedFormatIntentPrint

How to Create PDF from Word Document using VBA

How to Convert Word Table to PDF using VBA

Excel VBA TimeStamp – Milliseconds using Excel VBA

How to Get Time in Milliseconds using Excel VBA

The following function uses Timer function to get the milliseconds and append it to the current time

Public Function TimeInMS() As String

TimeInMS = Strings.Format(Now, "dd-MMM-yyyy HH:nn:ss") & "." & Strings.Right(Strings.Format(Timer, "#0.00"), 2)

End Function

Timer function returns a Single representing the number of seconds elapsed since midnight.

Another method is to use API Functions as shown below

Private Type SYSTEMTIME

wYear As Integer

wMonth As Integer

wDayOfWeek As Integer

wDay As Integer

wHour As Integer

wMinute As Integer

wSecond As Integer

wMilliseconds As Integer

End Type

Private Declare Sub GetSystemTime Lib "kernel32" _

(lpSystemTime As SYSTEMTIME)

Public Function TimeToMillisecond() As String

Dim tSystem As SYSTEMTIME

Dim sRet

On Error Resume Next

GetSystemTime tSystem

sRet = Hour(Now) & ":" & Minute(Now) & ":" & Second(Now) & _

":" & tSystem.wMilliseconds

TimeToMillisecond = sRet

End Function

Millisecond timer using VBA, How to get milliseconds in VBA Now() function, VBA Now() function, VBA Timer function , Excel VBA Timer, VBA Milliseconds

Excel VBA uninstall Excel Addins

Programmatically uninstall Excel Addins using VBA

Sub UnInstall_Addins_From_EXcel_AddinsList()

Dim oXLAddin As AddIn

For Each oXLAddin In Application.AddIns

Debug.Print oXLAddin.FullName

If oXLAddin.Installed = True Then

oXLAddin.Installed = False

End If

Next oXLAddin

End Sub

Embed Existing Word File to Spreadsheet using Excel VBA

Insert Existing File (Word Document) to Spreadsheet using VBA

Sub Insert_File_To_sheet()

Dim oWS As Worksheet ' Worksheet Object

Dim oOLEWd As OLEObject ' OLE Word Object

Dim oWD As Document ' Word Document Object (Use Microsoft Word Reference)

Set oWS = ActiveSheet

' embed Word Document

Set oOLEWd = oWS.OLEObjects.Add(Filename:="C:\VBADUD\Chapter 1.doc")

oOLEWd.Name = "EmbeddedWordDoc"

oOLEWd.Width = 400

oOLEWd.Height = 400

oOLEWd.Top = 30

' Assign the OLE Object to Word Object

Set oWD = oOLEWd.Object

oWD.Paragraphs.Add

oWD.Paragraphs(oWD.Paragraphs.Count).Range.InsertAfter "This is a sample embedded word document"

oOLEWd.Activate

End Sub

If you want to embed other document like PDF etc, you can do the same by

ActiveSheet.OLEObjects.Add Filename:= "C:\VBADUD\Sample_CH03.pdf", Link:=False, DisplayAsIcon:= False

Display embedded document as Icon

If you want to display the embedded document as an Icon set DisplayAsIcon property to True

Retrieve / Get First Row of Excel AutoFilter using VBA

Extract First Row of the Filtered Range using Excel VBA

We can create filters programmatically using Excel VBA () and also add multiple criteria to it (). Once we get the filtered data, either we extract the same or iterate each row in it and do some operations. Here is one such simple program to extract the rows of filtered range using VBA

Sub Get_Filtered_Range()

Dim oWS As Worksheet

Dim oRng As Range

Dim oColRng As Range

Dim oInRng As Range

On Error GoTo Err_Filter

oWS = ActiveSheet

oWS.UsedRange.AutoFilter(Field:=2, Criteria1:="Banana")

oRng = oWS.Cells.SpecialCells(xlCellTypeVisible)

oColRng = oWS.Range("A2:A5000")

oInRng = Intersect(oRng, oColRng)

MsgBox("Filtered Range is " & oInRng.Address)

MsgBox("First Row Filtered Range is " & oInRng.Rows(1).Row)

Finally:

If Not oWS Is Nothing Then oWS = Nothing

Err_Filter:

If Err <> 0 Then

MsgBox(Err.Description)

Err.Clear()

GoTo Finally

End If

End Sub

UnInstall Word Addins using VBA

Here is a simple method to uninstall a Word Addin (.dot file) using Word VBA

Private Sub UnInstalled_AllWordAddins()

Dim oAddin As AddIn

On Error GoTo Err_Addin

For Each oAddin In AddIns

If oAddin.Installed Then

msg = oAddin.Name

oAddin.Installed = False

End If

Next oAddin

Finally:

If Not oAddin Is Nothing Then Set oAddin = Nothing

Err_Addin:

If Err < > 0 Then

Err.Clear

GoTo Finally

End If

End Sub

Installed Word Addin

Word Addin List after Macro Execution. Addin is uninstalled (not removed)

Word VBA add command buttons through code

Add CommandButton to Word Document using VBA (through AddOLEControl)

Here is one of the ways to add a command button on a Word document using Word VBA

Sub Macro_Add_Button()

Dim oCtl

Dim oCmd

Set oCtl = ActiveDocument.InlineShapes.AddOLEControl(ClassType:="Forms.CommandButton.1")

Set oCmd = oCtl.OLEFormat.Object

oCmd.Caption = "Click Me..."

End Sub

Update Word Document with Excel Information using VBA

Excel Range to Word Template using VBA

Most often we maintain list of contacts in Excel workbook and it needs to be transferred to Word document (made from some template). Here is a simple snippet that can help:

The code is used to copy the content from Excel range shown below to a Word document:

<><> <><> <><> <><> <><> <><> <><> <><> <><> <><> <><> <><> <><> <><> <><> <><> <><> <><> <><> <><> <><>

Name	ContactNo	Address	Email
Christina	516 418 1234	Cincinatti	Christina@vbadud.com
Girish Kutty	516 418 6752	Cincinatti	gkutty@vbadud.com
Ravichand Koneru	777 213 213	Boston	rkoneru@vbadud.com

Sub CopY_Data_To_Word()

Dim oWA As Word.Application

Dim oWD As Word.Document

Set oWA = New Word.Application

Set oWD = oWA.Documents.Add("C:\Users\comp\Documents\Doc2.dot") ' Replace with your template here

For i1 = 2 To Cells.SpecialCells(xlCellTypeLastCell).Row

oWD.Bookmarks("Name").Range.Text = Cells(i1, 1)

oWD.Bookmarks("ContactNo").Range.Text = Cells(i1, 2)

oWD.Bookmarks("Address").Range.Text = Cells(i1, 3)

oWD.Bookmarks("Email").Range.Text = Cells(i1, 4)

'Code for saving the document

Next i1

' Releasing objects etc

End Sub

Bookmarks are added to the Word template and whenever a new document is created from the template, the document has those bookmarks.

The code above places the information from the Excel sheet to the specific Bookmark ranges

Excel to Word using VBA

How to Make a File ReadOnly using Excel VBA

How to Create ReadOnly Files using VBA - Excel VBA ReadOnly Function

There are many occassions where you want to save the file as Readonly (at times with a Password protection) after you complete the process. We have talked about SetAttr that changes the file attributes. Now let us see how to do this using FileSystemObject

Please refer How to iterate through all Subdirectories till the last directory in VBA to know how to include the references if you are using Early binding.

The following snippet uses late binding and shows how to set the file as read-only

Function MakeFileReadOnly(ByVal sFile As String)

Dim strSaveFilename As String

Dim oFSO As Object      'Scripting.FileSystemObject
Dim oFile As Object     'Scripting.File


    ' Create Objects
    ' Uses Late Binding
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFile = oFSO.GetFile(FilePath:=sFile)

    ' Set file to be read-only
    oFile.Attributes = 1
 
    ' Releasing Objects
    If Not oFSO Is Nothing Then Set oFSO = Nothing
    If Not oFile Is Nothing Then Set oFile = Nothing

End Function

The function is not restricted to Excel files alone and can be used for any kind of files

Once You are done you can  Check Workbook Attributes to confirm if the Workbook is ReadOnly

How to Create Hyperlinks in multiple cells using EXcel VBA

How to Link Cells to Files/Folders using Excel VBA

There are many cases where we want to have a Hyperlink on a cell that opens a document / image etc.
In the following snippet we can see how that works

The sheet is the Master Sheet, which contains the list of Products that are compared. The comparison reports for these products are placed in separate files in the same folder.

The hyperlink uses Relative path - you can hardcode this to any particular folder

Sub Create_HyperLinks()

Dim i1 As Integer
Dim sA, sB As String

For i1 = 2 To Cells.SpecialCells(xlCellTypeLastCell).Row
    If LenB(Trim$(Cells(i1, 3).Value)) <> 0 Then
        sA = Trim$(Cells(i1, 1).Value)
        sB = Trim$(Cells(i1, 2).Value)
        sA = "Compared_" & sA & "_" & sB & ".xls"
        Sheets(1).Range("C" & i1).Hyperlinks.Add Cells(i1, 3), "CompareReports\" & sA
    End If
Next i1


End Sub

See also: Convert URLs to Hyperlinks using VBA

How to Split Text in a Cell to Multiple Cells using Excel VBA

Convert a Text to Range using Excel VBA

The following snippet converts the Text to an Array by splitting using SemiColon delimiter and uses the Transpose Function to place it in the Range

Sub ConvertText2Range()

Dim sText As String, arText

sText = Range("c16").Value

arText = Split(sText, ";")

Range("D16:D" & CStr(16 + UBound(arText))).Value = WorksheetFunction.Transpose(arText)
End Sub