PDA

View Full Version : [SOLVED:] Search & Insert Source Documents - Using a Spreadsheet



ap7
04-13-2016, 10:14 AM
Greetings to all the experts,

thank you for reading my post.:)

I am new to vba programs.
I found a macro - I can't post link here but I believe the author is Doug Graham found on msdn.

Which allows me to search and replace from a spreadsheet source.

I am further speculating whether it is possible at all to insert source documents similarly?

That is search for the code in word documents listed in Column A -
if found in the document - insert the source document
Move on to next document

Here is a snapshot of the spreadsheet that lists sample files. There are 100+ files listed

15914


I have been using this below





Sub ReplaceFromXL()


Dim xlapp As Object
Dim xlbook As Object
Dim xlsheet As Object
Dim xlrange1 As Object
Dim xlrange2 As Object
Dim myarray As Variant
Dim Findarray As Variant
Dim Replarray As Variant
On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")
If Err Then
bstartApp = True
Set xlapp = CreateObject("Excel.Application")
End If
On Error GoTo 0
With xlapp
Set xlbook = .Workbooks.Open("C:\Users\APPC\Desktop\Replace.xlsx")
Set xlsheet = xlbook.Worksheets(1)
With xlsheet
Set xlrange1 = .Range("A1", .Range("A1").End(4))
Set xlrange2 = .Range("B1", .Range("B1").End(4))
Findarray = xlrange1.Value
Replarray = xlrange2.Value
End With
End With
If bstartApp = True Then
xlapp.quite
End If
Set xlapp = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing
Set xlrange1 = Nothing
Set xlrange2 = Nothing
For i = 2 To UBound(Findarray)
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = Findarray(i, 1)
.Replacement.Text = Replarray(i, 1)
.MatchWildcards = False
.Wrap = wdFindContinue
.MatchCase = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next i

End Sub




I would like to search for the code in my documents and then insert the corresponding source document.

If an expert would be kind enough to nudge me in the right direction that would be a start.

The documents will be in a folder that need to be searched.

If the code from the column is found in a document - insert the appropriate source document.
I have hundreds of documents that I am editing and manually it is becoming a very difficult task.

Any advice on this appreciated
many thanks for your time in advance

ap7

gmaxey
04-13-2016, 11:04 AM
Option Explicit
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim varList
Dim lngIndex As Long
Dim strSQL As String
Dim oRng As Word.Range
strSQL = "SELECT * FROM [Sheet1$];"
fcnGetExcelList varList, ThisDocument.Path & Application.PathSeparator & "GetData.xlsx", "True", strSQL
For lngIndex = 0 To UBound(varList)
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = varList(0, lngIndex)
If .Execute Then
oRng.InsertFile varList(2, lngIndex) & "\" & varList(1, lngIndex)
oRng.Collapse wdCollapseEnd
End If
End With
Next
lbl_Exit:
Exit Sub
End Sub
Public Function fcnGetExcelList(varPassed As Variant, strWorkbook As String, _
bSuppressHeader As Boolean, strSQL As String)
Dim oConn As Object
Dim oRS As Object
Dim lngNumRecs As Long
Dim strConnection As String
'Create connection:
Set oConn = CreateObject("ADODB.Connection")
If bSuppressHeader Then
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkbook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
Else
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkbook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=NO"";"
End If
oConn.Open ConnectionString:=strConnection
Set oRS = CreateObject("ADODB.Recordset")
'Read the data from the worksheet.
oRS.Open strSQL, oConn, 3, 1 '3: adOpenStatic, 1: adLockReadOnly
With oRS
'Find the last record.
.MoveLast
'Get count.
lngNumRecs = .RecordCount
'Return to the start.
.MoveFirst
End With
varPassed = oRS.GetRows(lngNumRecs)
'Cleanup
If oRS.State = 1 Then oRS.Close
Set oRS = Nothing
If oConn.State = 1 Then oConn.Close
Set oConn = Nothing
lbl_Exit:
Exit Function
End Function

ap7
04-13-2016, 12:09 PM
Dear Greg,

I have been lurking on the forums and have seen some of your outstanding work.:)

I was a bit aprehensive about posting such a complex task, as i know its not nice to expect code,its a privilege and not an entitlement to get help.


I can see from the code, this is very advanced, I don't know what it all means, but I can see its not basic stuff.

I tested the code and it flawlessly worked.

I need to work out how to point it to my folder of documents.
I will investigate this but I am really really impressed, and so quick as well for you to come and help a stranger.

Thank you very very much great Sir

Just in case I cant work out how to point to the folder, I will post back later with my code

Thank you again, I am deeply indebted to you

Andrew

gmaxey
04-13-2016, 12:19 PM
You're welcome. I've got to go off now, but if you will be more specific about what you need to do, I may be able to offer some additional help.

ap7
04-13-2016, 12:51 PM
Hello Greg,

I simply wanted to - I believe the terminology is loop through the documents?

That is there is a Folder that holds all the documents.

I would like to Apply this macro to all the documents - this would help me out greatly, so I don't have to open each document individually and run this macro.

I hope this makes sense

Thank you again.

Andrew

gmaxey
04-13-2016, 04:08 PM
See my: http://gregmaxey.mvps.org/word_tip_pages/process_batch_folder_addin.html

You could make the code above a batch process macro.

ap7
04-13-2016, 05:19 PM
Greg,

again I would like to extend my deepest thanks. :)

This is such a fantastic programed process - it will cut my work load in half. I need to collect different files and collate them into different specs, its often repetitive and time consuming.

I wish I knew how to explain and request help months ago - would have saved my self hours of work.

I will set the batch process addin up, that's a bonus.

Greatest respect for your work

Do Take care
Cheers:beerchug:

Andrew