I need my VBA code fixing ! It doesnt recognise UK mobile numbers in word documents
2991
£20(approx. $25)
- Posted:
- Proposals: 4
- Remote
- #1018192
- Archived
Description
Experience Level: Entry
General information for the business: I process documents - lots of them
Description of requirements/functionality: I need my VBA code adjusting so that it correctly identifies UK mobile phone numbers from CV documents I regularly receive. These documents are unstructured and the mobile number is often written in the incorrect format,
At the moment the code identifies any text with a "7" digit in and brings back the text before and after it. So it brings back mobile numbers, but also this brings back dates, prices, numbers, non mobile numbers, etc.
I need the code correcting so it only brings back the mobile number in the correct format,
PS it may be worth referencing wikipedia for the UK mobile number format
MY CODE
________________
Public Sub GetTele()
Dim pWordApp As Object
Dim pWordDoc As Object
Dim pDir As String
Dim pFileName As String
Set pWordApp = CreateObject("word.application")
pWordApp.Visible = True
pDir = InputBox(Prompt:="Enter Directory.", title:="Directory", Default:="DIR HERE")
pFileName = Dir(pDir + "*.doc")
Do Until Len(pFileName) = 0
Set pWordDoc = pWordApp.Documents.Open(pDir & pFileName)
With pWordApp.Selection.Find
.Text = "?????7[ 0-9]{1,14}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
pWordApp.Selection.Find.Execute
Do While pWordApp.Selection.Find.Found
pWordApp.Selection.Copy
Selection.TypeText (pFileName & " // ")
Selection.Paste
Selection.InsertParagraphAfter
Selection.EndKey Unit:=wdStory
pWordApp.Selection.EndKey Unit:=wdLine
With pWordApp.Selection.Find
.Text = "?????7[ 0-9]{1,14}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
pWordApp.Selection.Find.Execute
Loop
pWordDoc.Close
Set pWordDoc = Nothing
pFileName = Dir
Loop
pWordApp.Quit
Set pWordApp = Nothing
End Sub
OS requirements: Windows
Extra notes:
Description of requirements/functionality: I need my VBA code adjusting so that it correctly identifies UK mobile phone numbers from CV documents I regularly receive. These documents are unstructured and the mobile number is often written in the incorrect format,
At the moment the code identifies any text with a "7" digit in and brings back the text before and after it. So it brings back mobile numbers, but also this brings back dates, prices, numbers, non mobile numbers, etc.
I need the code correcting so it only brings back the mobile number in the correct format,
PS it may be worth referencing wikipedia for the UK mobile number format
MY CODE
________________
Public Sub GetTele()
Dim pWordApp As Object
Dim pWordDoc As Object
Dim pDir As String
Dim pFileName As String
Set pWordApp = CreateObject("word.application")
pWordApp.Visible = True
pDir = InputBox(Prompt:="Enter Directory.", title:="Directory", Default:="DIR HERE")
pFileName = Dir(pDir + "*.doc")
Do Until Len(pFileName) = 0
Set pWordDoc = pWordApp.Documents.Open(pDir & pFileName)
With pWordApp.Selection.Find
.Text = "?????7[ 0-9]{1,14}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
pWordApp.Selection.Find.Execute
Do While pWordApp.Selection.Find.Found
pWordApp.Selection.Copy
Selection.TypeText (pFileName & " // ")
Selection.Paste
Selection.InsertParagraphAfter
Selection.EndKey Unit:=wdStory
pWordApp.Selection.EndKey Unit:=wdLine
With pWordApp.Selection.Find
.Text = "?????7[ 0-9]{1,14}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
pWordApp.Selection.Find.Execute
Loop
pWordDoc.Close
Set pWordDoc = Nothing
pFileName = Dir
Loop
pWordApp.Quit
Set pWordApp = Nothing
End Sub
OS requirements: Windows
Extra notes:
Timothy L.
100% (69)Projects Completed
51
Freelancers worked with
60
Projects awarded
44%
Last project
1 Feb 2022
Switzerland
New Proposal
Login to your account and send a proposal now to get this project.
Log inClarification Board Ask a Question
-
There are no clarification messages.
We collect cookies to enable the proper functioning and security of our website, and to enhance your experience. By clicking on 'Accept All Cookies', you consent to the use of these cookies. You can change your 'Cookies Settings' at any time. For more information, please read ourCookie Policy
Cookie Settings
Accept All Cookies