Find and replace from access to word

Carlit007

New Member
Joined
Sep 5, 2018
Messages
47
Office Version
  1. 2019
  2. 2016
  3. 2013
Platform
  1. Windows
  2. MacOS
Hi all just recently migrated to access still learning hoping somebody could point me in the right direction.

So I have a table containing property serial number as well as location information for inventory purposes.

What im Trying to do is figure out if theres a way to loop thru each records which have “serialNumber” as the key

Thru vba file-dialog I want to open Open a ms word file containing inventory report
In the word document every-time the Serial number from the table is found for it to be replaced by itself plus a concatenated string such as [SerialNumber]&[room]&[desk]&[person] all coming from the access table

The result would be a serial number for each item on the ms word report with the location right next to it

I have been able to get this to work in excel Vba but am not familiar with the Access objects in VBA

What is the best way to possibly accomplish this in Access?
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
I will offer an answer to the last question by way of a question. Do you really have to manipulate Word as opposed to outputting an Access report as a pdf?
Anyway, to point you in a particular direction, Google "ms access automation of word". Pretty sure your docx needs to have either form fields or bookmarks, but you didn't say. Perhaps code at this link will get you started (or someone who has code at the ready will chime in). I would think you could do this with simple concatenation (not really replacing, as in the sense of using Access Replace function); something like (borrowed code from that link):

VBA Code:
With objWordDoc.Bookmarks
   If .Exists("YourBookMarkName") Then
       .Item("YourBookMarkName").Range.Text = .Item("YourBookMarkName").Range.Text & "your value"
   End If
End With
TBH, I'd probably assign the Text value to a variable and repeat the variable to make it look a little less confusing/complicated.

 
Last edited:
Upvote 0
I will offer an answer to the last question by way of a question. Do you really have to manipulate Word as opposed to outputting an Access report as a pdf?
Anyway, to point you in a particular direction, Google "ms access automation of word". Pretty sure your docx needs to have either form fields or bookmarks, but you didn't say. Perhaps code at this link will get you started (or someone who has code at the ready will chime in). I would think you could do this with simple concatenation (not really replacing, as in the sense of using Access Replace function); something like (borrowed code from that link):

VBA Code:
With objWordDoc.Bookmarks
   If .Exists("YourBookMarkName") Then
       .Item("YourBookMarkName").Range.Text = .Item("YourBookMarkName").Range.Text & "your value"
   End If
End With
TBH, I'd probably assign the Text value to a variable and repeat the variable to make it look a little less confusing/complicated.

Hi @Micron so after much trial and error everything just clicked and I was able to come up with the code below by piecing what I already had in Excel VBA and what I learned with MS Access VBA.

the code takes a while to complete because I have around 756 records to go thru but I am proud to say it works :)
not sure if its the best way If anybody has any tips on how I can speedup this code or a more efficient way please feel free to chime in I'm eager to keep learning

thanks again for motivating me to give access a try!

VBA Code:
Option Compare Database
Option Explicit

Public Sub PropertyBookLocationAccessV1()

Dim WordDoc As Word.Document
Dim WordApp As Word.Application
Dim objWord As Word.Application
Dim rst As DAO.Recordset
Dim db As Database

Set WordApp = CreateObject(Class:="Word.Application")

Dim strDocx As String
strDocx = funSelectDocx() ' uses filedialog function to select file


Set db = CurrentDb
Set rst = db.OpenRecordset("qryPlocation")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Open(strDocx)

MsgBox "OKAY LET ME DO MY THING JUST SIT BACK AND RELAX THIS WILL TAKE A FEW MINUTES"
  
  Do Until rst.EOF ' begin loop thu all the recordset
  
        With WordDoc.Content.Find 'CTRL finds every key in MS WORD the Replaces results with code below
  
 
        .Text = rst![SerialNumber]
        .Replacement.Text = rst![SerialNumber] & " ( " & rst![ADMIN] & " " & rst![ROOM] & rst![DESK] & " " & rst![smDATA] & ")"
        .Replacement.Font.Bold = True
        .Replacement.Font.Color = vbBlue ' R0,G0, B255     THIS COLORS THE RESULT ABOVE BOLD & BLUE
        .Forward = True
        .Forward = True
        .Wrap = 1 ' = wdFindContinue if in Word
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=2 ' wdReplaceAll if in Word
  
'/////////////////////////this line is added to exclude Serial from code above//////////////////////////////
   
        With WordDoc.Content.Find
        .Text = rst![SerialNumber]
        .Replacement.Text = rst![SerialNumber]
        .Replacement.Font.Bold = False
        .Replacement.Font.Color = vbBlack
        .Forward = True
        .Forward = True
        .Wrap = 1 ' = wdFindContinue if in Word
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=2 ' wdReplaceAll if in Word
  

            End With
'////////////////////////////////////////////////////////////////////////////////////////////////////////////

 End With

 rst.MoveNext


Loop ' ends loop

        WordApp.ActiveDocument.Save
        WordApp.ActiveDocument.Close
        WordApp.Quit
        Set WordApp = Nothing
        Set WordDoc = Nothing
        Set db = Nothing

MsgBox "ALL SET YOURE WELCOME :)"

End Sub
Function funSelectDocx() As String
    Dim dlgFileDialog As FileDialog
    Dim varCurrentPathAndFilename As Variant
    Set dlgFileDialog = Application.FileDialog(msoFileDialogOpen)
    dlgFileDialog.TITLE = "Open"
    dlgFileDialog.Filters.Clear
    dlgFileDialog.Filters.Add "Word Documents", "*.docx"
    dlgFileDialog.AllowMultiSelect = False
    ' If a file is selected from the dialog box...
    If dlgFileDialog.Show = -1 Then
        funSelectDocx = dlgFileDialog.SelectedItems(1)
    Else
        MsgBox "No *.docx file was selected", TITLE:="Open"
    End If
End Function
 
Upvote 0
Impressive; just took a quick look. What I might change:
- you've declared a word object variable 2x but only Set one of them.
- would test that the function returns a value, otherwise you're proceeding and strDocx could be Null.
 
Upvote 0

Forum statistics

Threads
1,223,888
Messages
6,175,206
Members
452,618
Latest member
Tam84

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top