Saturday, January 25, 2014

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

Monday, October 14, 2013

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

Sunday, May 26, 2013

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

Friday, May 11, 2012

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


Sunday, May 06, 2012

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


Girish Kutty

516 418 6752

Cincinatti


Ravichand Koneru

777 213 213

Boston



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




Wednesday, May 02, 2012

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

Wednesday, February 29, 2012

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

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


Related Posts Plugin for WordPress, Blogger...

Visual Basic for Applications (VBA) Forum (recent threads)

CodeKeep VBA Feed

Visual Studio Tools for Office Forum (recent threads)

Download Windows Live Toolbar and personalize your Web experience! Add custom buttons to get the information you care about most.

Office Business Applications (OBA) Team Blog

MSDN Code Gallery Published Resources For Tag VSTO

microsoft.public.vsnet.vstools.office Google Group