Access to search Excel

GavZ

Mostly Beginners Luck!
Local time
Today, 20:43
Joined
May 4, 2007
Messages
56
HI

Is it possible to use Access to search an Excel document for phone numbers and if it finds one to store it in a table?

Thanks
 
well you could link the excel sheet to access and then run a query over it, but its just as easy to open up excel and hit F4. Plus how would you determine that it is a telephone number.
 
There might be an easier way to find phone numbers but here is how I searched a document to find a pattern.

Basically it goes through each cell and when the cell has something it then checks if the pattern of that cell matches what I wanted.

It was set up to accept a Workbook and then to go through all the worksheets, in other words the whole excel workbook. It will only find something once, so if the same thing exists again this will not save it.

My pattern was 2321X67987 or Four Numbers One Letter and Five Numbers
this can be seen here
Code:
.Pattern = "\b[0-9]{4}[A-Z][0-9]{5}\b"
You really only need to change the pattern to test for you to get started and look at how this works.

Code:
Private Sub FindPattern(eWkb As Excel.Workbook)
On Error GoTo Err_FindPattern

Dim startCell As String
Dim rng As Excel.Range
Dim lastCell As Excel.Range
Dim cel As Excel.Range
Dim newCell As Boolean
Dim eWks As Excel.Worksheet
Dim eFinalAKZ As String
Dim eAKZ As String
Dim str_comment As String

On Error Resume Next

For Each eWks In eWkb.Worksheets


Set rng = eWks.UsedRange

On Error GoTo Err_FindPattern

    If Not rng Is Nothing Then
        On Error Resume Next
        Set cel = rng.Cells(1).Find(What:="*", SearchDirection:=xlNext, LookAt:=xlPart)
        If cel Is Nothing Then Set cel = rng.Find(What:="*", After:=rng.Cells(1))
        On Error GoTo 0
        If Not cel Is Nothing Then
            newCell = True
            Do While newCell
                If findit(cel) Then
                    If eFinalAKZ <> "" Then eFinalAKZ = eFinalAKZ & ";"
                    eFinalAKZ = eFinalAKZ & returnit(cel)
                End If
                returnit (cel)
                Set lastCell = cel
                Set cel = rng.Find(What:="*", After:=cel)
                newCell = (cel.Column > lastCell.Column And cel.Row = lastCell.Row) Or cel.Row > lastCell.Row
            Loop
        End If
    End If

Next eWks


Debug.Print "Final Result - " & eFinalAKZ

'eFinalAKZ can be 3 things - nothing - many numbers with a ";" separator - just one AKZ
If InStr(eFinalAKZ, ";") > 0 Then
    'AKZ has ";" in it so there is more than one. Get the first AKZ as the suggested one
    'so take Left with the position from the first ";" that appears in the string
    eAKZ = Left(eFinalAKZ, (InStr(eFinalAKZ, ";") - 1))
Else
    'there is only one AKZ or nothing if nothing then both will be nothing
    eAKZ = eFinalAKZ
End If

Set rng = Nothing
Set lastCell = Nothing
Set cel = Nothing
Set eWks = Nothing


Exit_FindPattern:
    Exit Sub

Err_FindPattern:
    MsgBox "FindPattern - " & Err.Description & " No." & Err.Number
    Resume Exit_FindPattern
End Sub


Function findit(str) As Boolean
On Error GoTo Err_findit

Dim regex As Object
Dim itm As Variant

        Set regex = CreateObject("vbscript.regexp")
        With regex
            .ignorecase = True
            .Pattern = "\b[0-9]{4}[A-Z][0-9]{5}\b"
        End With
        findit = regex.test(str)

Exit_findit:
    Exit Function

Err_findit:
    MsgBox "Excelfindit - " & Err.Description & " No." & Err.Number
    Resume Exit_findit
End Function



Function returnit(str) As String
On Error GoTo Err_returnit

Dim regex As Object
Dim itm As Object
Dim matches As Object

    Set regex = CreateObject("vbscript.regexp")
    With regex
        .ignorecase = True
        .Global = True
        .Pattern = "\b[0-9]{4}[A-Z][0-9]{5}\b"
    End With
    Set matches = regex.Execute(str)
    For Each itm In matches
        If returnit <> "" Then returnit = returnit & ";"
        returnit = returnit & itm
    Next

Exit_returnit:
    Exit Function

Err_returnit:
    MsgBox "Excelreturnit - " & Err.Description & " No." & Err.Number
    Resume Exit_returnit
End Function
 
well you could link the excel sheet to access and then run a query over it, but its just as easy to open up excel and hit F4. Plus how would you determine that it is a telephone number.
If you do a little googling on "regexp" I am sure you will get many ideas on the possible patterns of phone numbers.
 

Users who are viewing this thread

Back
Top Bottom