Excel: Add leading zeroes to a number

I wanted to add leading zeroes to a number column, making a seven-digit number. I found the REPT function:

=IF(LEN(A2)>7,A2,REPT("0",7-LEN(A2))&A2)

If the cell is longer than 7 digits, it puts the whole cell value in. If it is 7 or less, it will “repeat” the zero the required number of times.

Hope this helps 🙂

Excel: Find and replace across all worksheets

I needed to remove carriage returns, line feeds and tab characters from an Excel spreadsheet that was copied straight out of Microsoft Access, and have written the script below, which has the other options for replacing if you need to change it:

Please ensure you test any script taken from my website on a test/development machine, before running on a production server

Option Explicit
 
Sub FindAndReplaceInAllWorkSheets()
     
    Dim WS              As Worksheet
    Dim Search          As String
    Dim Replacement     As String
     
    Search = Chr(10) 'Find Lf
    
    'Other options
    'Search = Chr(9) 'Find tabs
    'Search = Chr(13) + Chr(10) 'Find CrLf
    'Search = Chr(13) 'Find Cr
    
    Replacement = "
"
     
    For Each WS In Worksheets
        WS.Cells.Replace What:=Search, Replacement:=Replacement, _
        LookAt:=xlPart, MatchCase:=False
    Next
     
End Sub

Outlook: Prefixing .MSG (message) files with the date the e-mail was sent

I recently copied all my e-mails out of an archive folder, so I could zip them up on my hard drive. To do this I wanted to rename each file with the date the email was sent, using the format YYYY-MM-DD.

The VBA code below works for me 🙂

Please ensure you test any script taken from my website on a test/development machine, before running on a production server

 
Sub GetMessageDate()
    Dim OlApp As Outlook.Application
    Set OlApp = GetObject(, "Outlook.Application")
    Dim MsgFilePath
    Dim Eml As Outlook.MailItem
    Dim Path As String
    Path = "C:Outlook Files"
    
    If OlApp Is Nothing Then
        Err.Raise ERR_OUTLOOK_NOT_OPEN
    End If

    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    Dim temp As Object
    Set temp = fs.GetFolder(Path)
    
    For Each MsgFilePath In temp.files
        Set Eml = OlApp.CreateItemFromTemplate(Path & MsgFilePath.Name)
        'Now rename the file
        Name Path & MsgFilePath.Name As Path & Format(Eml.SentOn, "YYYY-MM-DD") & " " & MsgFilePath.Name
        Set Eml = Nothing
    Next
    
    Set OlApp = Nothing
End Sub

Word: Crop settings in 2007 and 2010

Yesterday I was trying to split an image into 9 separate parts using Microsoft Word 2010, so I could print them out, and when put together would be about the same size as an A2 piece of paper. But I just could not work it out!!!

In Word 2007, the settings were straight forward. Just specify the amount to crop from the left, right, top and/or bottom, and that’s it. But Word 2010 has “Offset X”, “Offset Y”, etc.

In the end, I uninstalled Office 2010, and went back to Office 2007.

Here are the settings in Word 2007:

Word 2007 Crop Settings

You will see that the height of the original image was 30.24cm, so I split this into three vertical measurements of 10.08cm.

The width of original image was 19.84cm, which I split into three horizontal measurements of 6.61cm

The image above shows the crop settings when doing the top left part. i.e. cropping 20.16cm from the bottom of the image, leaving 10.08cm of the top, and 13.22cm from the right of the image, leaving 6.62cm.

Continue reading

Excel: Remove HTML Tags and Escape Codes from an Excel selection

The code below can be used to remove HTML tags and escape codes from an Excel selection.  Simply page the code into a new module, select the relevant cells to be processed, and press run.

Please ensure you test any script taken from my website on a test/development machine, before running on a production server

I would suggest that you copy the original cells to another sheet and then try it on the copy first, just to make sure it works the way you want.

I have found a list of the Escape Codes, at http://www.bryanlprice.com/specials.html, but there are others.  I haven’t included all of them in the code below, as they were not relevant for my purposes.

I have also found a list of HTML character codes, at http://www.btinternet.com/~andrew.murphy/html_character_set.html.

Option Explicit

Private Sub RemoveHTMLTagsAndEscapeCodes()

    On Error Resume Next
    Dim iLT As Long
    Dim iGT As Long
    Dim sTag As String
    Dim sHTML As String
   
    Dim Cell As Range
    'For each cell within the active selection
    For Each Cell In Selection
        sHTML = Cell.Value
     
        'Find and remove all HTML tags
        iLT = InStr(sHTML, "<")
        iGT = InStr(sHTML, ">")
       
        Do While iLT > 0 And iGT > 0 And iGT > iLT
            'Extract the tag
            sTag = Mid$(sHTML, iLT, iGT - iLT + 1)
           
            'Remove the tag from the HTML string
            sHTML = Replace(sHTML, sTag, "")

            'Find the next HTML tag
            iLT = InStr(sHTML, "<")
            iGT = InStr(sHTML, ">")
        Loop

        'Remove carriage returns and line feeds from the beginning
        Do While Left(sHTML, 1) = vbCr Or Left(sHTML, 1) = vbLf
            sHTML = Mid$(sHTML, 2)
        Loop
        'And, from the end
        Do While Right(sHTML, 1) = vbCr Or Right(sHTML, 1) = vbLf
            sHTML = Left$(sHTML, Len(sHTML) - 1)
        Loop
     
        'Replace HTML escape codes with hyphens
        sHTML = Replace(sHTML, "–", "-")
        sHTML = Replace(sHTML, "—", "-")
        sHTML = Replace(sHTML, "­", "-")
       
        'Replace HTML escape codes with single quotes
        sHTML = Replace(sHTML, "‘", "'")
        sHTML = Replace(sHTML, "’", "'")
        sHTML = Replace(sHTML, "'", "'")
       
        'Replace HTML escape codes with double quotes
        sHTML = Replace(sHTML, "“", Chr(34))
        sHTML = Replace(sHTML, "”", Chr(34))
        sHTML = Replace(sHTML, """, Chr(34))
       
        'Replace other HTML escape codes
        sHTML = Replace(sHTML, " ", " ")
        sHTML = Replace(sHTML, "&", "&")
        sHTML = Replace(sHTML, "&#", "#")
        sHTML = Replace(sHTML, "<", "<")
        sHTML = Replace(sHTML, ">", ">")
        sHTML = Replace(sHTML, "£", "£")
        sHTML = Replace(sHTML, "€", "€")
        sHTML = Replace(sHTML, "®", "(R)")
        sHTML = Replace(sHTML, "©", "(C)")

        'Replace HTML character codes
        sHTML = Replace(sHTML, "%20;", " ")
        sHTML = Replace(sHTML, "#38;", "&")
        sHTML = Replace(sHTML, "#39;", "'")
        sHTML = Replace(sHTML, "#160;", "á")
        sHTML = Replace(sHTML, "#163;", "£")
        sHTML = Replace(sHTML, "#187;", "+")
        sHTML = Replace(sHTML, "#233;", "é")
        sHTML = Replace(sHTML, "#729;", " ")
        sHTML = Replace(sHTML, "#937;", " ")
        sHTML = Replace(sHTML, "#8260;", "/")
        sHTML = Replace(sHTML, "#8800;", "-")
        sHTML = Replace(sHTML, "#8232;", " ")
        sHTML = Replace(sHTML, "#8710;", " ")
        sHTML = Replace(sHTML, "#8722;", "-")
        sHTML = Replace(sHTML, "#8734;", "°")
        sHTML = Replace(sHTML, "#8747;", " ")
       
        'Remove any double spaces
        Do While Instr(sHTML, "  ") > 0
                sHTML = Replace(sHTML, "  ", " ")
        Loop
        'Remove leading or trailing spaces
        sHTML = Trim$(sHTML)

        'Return the result
        Cell.Value = sHTML
    Next
End Sub


Excel: Error “HRESULT 0x800A03EC” when outputting data to Excel

Sometime ago, I wrote a Query Tool application that output data from a database into Excel.  However, in the past few days, the users have been getting the “HRESULT 0x800A03EC” exception error when running a specific query.

I knew that the application was working, because other query data was being output to Excel.

I decided to check the fields that were being output from SQL Server.  Removing the fields one by one, I was able to find that if the field value began with an equal sign (=), it would cause the exception.  Removing the equal sign from the start of the field, removed the exception error.  Yippee 🙂

Access: Remove “dbo_” prefix from imported tables

The procedure below, can be used to remove the “dbo_” prefix from all imported tables within a Microsoft Access Database.

Please ensure you test any script taken from my website on a test/development machine, before running on a production server

Public Sub Remove_DBO_Prefix()
 
    Dim obj As AccessObject
    Dim dbs As Object
 
    Set dbs = Application.CurrentData
 
    'Search for open AccessObject objects in AllTables collection.
    For Each obj In dbs.AllTables
 
        'If found, remove prefix
        If Left(obj.Name, 4) = "dbo_" Then
            DoCmd.Rename Mid(obj.Name, 5), acTable, obj.Name
        End If
 
    Next obj
 
End Sub

VB: The ‘Microsoft.Jet.OLEDB.4.0’ provider is not registered on local machine

I was in the middle of writing an application to retrieve the list of Access Database Tables, but I was getting the error “The ‘Microsoft.Jet.OLEDB.4.0’ provider is not registered on the local machine.”

I discovered, that as I was using Vista x64, I needed to change the “Advanced Compiler Options” in Visual Studio to target the “x86” CPU, thereby creating a 32-bit application.

Advanced Compiler Options

When I tried again, it worked