Hi all!

I'm looking for a way to batch find/replace paths in field codes using a macro. My document template has a couple hundred links to named cells in an excel template.

The process is that I open my excel template, run a macro* to open a specific .dot file, then save both the template .xls file and .dot file to a new folder with a common name. *Major props to Razor2.3 for helping out with that one! Will post the revised code if anybody wants it.

What I'm left with is a new .doc and .xls file, based on the template. The .doc template's path to the excel cells is \\\\server\\path\template.xls, but I need to append more commands to my "save as" macro [with pre-defined sName and sPath variables] so that it opens up the resultant sName.doc file and batch replaces the existing template path with my sPath\sName.xls path.

Thanks,

Hoop

Know what this post could use? Some of the field codes in question. Especially if said field codes have the same name as part of the old path.

In general, it would look like this for each link, and there are several hundred links:

{ LINK Excel.Sheet.8 "\\\\HoopServer\\VOL1\\DATA\\JOBS\\123AnywhereStreet_Anytown_Anycounty_GA\\Worksheetname.xls" ANSWERSTAB!ANS_RECONCILEDMARKETVALUE \a \t \* MERGEFORMAT }

Well, I'm far from happy with this code, but I don't really have time to work on it, and it does work, more or less. The biggest problem I couldn't overcome is the actual pulling of data in the fields. Apparently, there's some sort of problem with Excel running VBA code and pulling data at the same time, so Word considers the links broken. I've added code to 'fix' this, but it requires adding VBA to the Word document. I based this off of what I came up with last time.

Option Explicit

Sub AssembleReport()
Dim sTemplates As String
Dim sSaveName As String
Dim sLookFor As String
Dim oWord As Object
Dim oField As Object
Set oWord = CreateObject("Word.Application")

'Get the location of the Template directory
With CreateObject("WScript.Shell")
sTemplates = .ExpandEnvironmentStrings("%UserProfile%\Templates\")
End With

'Get this workbook's network path (What Word looks for)
sLookFor = SDblSlash(SToNetworkName(ThisWorkbook.FullName))

'Get the name/location for saving
sSaveName = SToNetworkName(SGetLoc)

'Save the Excel Sheet
ActiveWorkbook.SaveCopyAs sSaveName & ".xls"

'Open the template
With oWord.Documents.Open(sTemplates & SGetName)
oWord.Visible = True
'Update the field codes
For Each oField In .Fields
Application.StatusBar = "Updating field " & oField.Index
oField.Code.Text = Replace(oField.Code, sLookFor, """" & SDblSlash(sSaveName) & ".xls""", , , 1)
oField.Code.Text = Replace(oField.Code, SDblSlash(ThisWorkbook.FullName), "'" & SDblSlash(sSaveName) & ".xls""", , , 1)
oField.Code.Text = Replace(oField.Code, """""", """")
oField.Update
Next
Application.StatusBar = ""

.VBProject.VBComponents(1).CodeModule.AddFromString _
"Private Sub Document_Open()" & vbNewLine & _
"ThisDocument.Fields.Update" & vbNewLine & _
"End Sub"

'Saving our Word work
.SaveAs sSaveName & ".doc"
End With

'Cleanup
If Not oWord Is Nothing Then
oWord.Quit 0
Set oWord = Nothing
End If
End Sub

Private Function SGetLoc()
'Save dialog
SGetLoc = Application.GetSaveAsFilename()

'Remove any extension (I.E. .xls)
If InStrRev(SGetLoc, ".") Then _
SGetLoc = Left(SGetLoc, InStrRev(SGetLoc, ".") - 1)
End Function

Private Function SGetName()
SGetName = ActiveSheet.Range("G5").Value
End Function

Private Function SDblSlash(sIn As String)
SDblSlash = Replace(sIn, "\", "\\")
End Function

Private Function SToNetworkName(sIn As String)
Dim sName As String
Dim i As Integer
Dim cDrives As Object

sName = sIn
If Mid(sName, 2, 1) <> ":" Then
'Not a drive letter, mapped or otherwise
SToNetworkName = sName
Exit Function
End If

Set cDrives = CreateObject("WScript.Network").EnumNetworkDrives
With cDrives
For i = 0 To .Count - 1 Step 2
If InStr(1, Mid(sName, 1, 2), .Item(i), 1) And CBool(Len(.Item(i))) Then
'Found the network drive we're using
sName = .Item(i + 1) & Mid(sName, 3)
Exit For
End If
Next
End With
SToNetworkName = sName
End Function

Thanks, Razor2.3

This ALMOST works perfectly. When I run the macro, it gives an error on the link. When you go into Edit->Links, it says:

Source file: [With correct path to file]
Item: [With correct sheet name and field name]
Type: Excel.Sheet.8 [Bonk.]

If I go in and say "Change Source" and post to the same exact source file, the "Excel.Sheet.8" part changes to "Worksheet" and the thing works.

Is there a part of what you wrote that says Excel.Sheet.8, and/or a way to change it to post a "Worksheet" into the type column?

Almost there. You the man!

Thanks, Razor2.3

This ALMOST works perfectly. When I run the macro, it gives an error on the link. When you go into Edit->Links, it says:

Source file: [With correct path to file]
Item: [With correct sheet name and field name]
Type: Excel.Sheet.8 [Bonk.]

If I go in and say "Change Source" and post to the same exact source file, the "Excel.Sheet.8" part changes to "Worksheet" and the thing works.

Is there a part of what you wrote that says Excel.Sheet.8, and/or a way to change it to post a "Worksheet" into the type column?

It's really weird. I just tried it out with three field codes to see what was happening. I "changed source" on the first two and left the third as an invalid link. They ALL three look exactly the same in their formatting, but the third one doesn't work. Very odd.

Almost there. You the man!

After further review...

Word doesn't like the .VBProject..... part. Error 6068.

I got it to work, sort of.

I think it has to do with the xls file (the "end product" xls file, not the template that generates the NAME.doc and NAME.xls file) not being open. I hit "Update Fields" in Edit->Links and got a dialog box about macro security that you normally get when you open the file. After it was open, it updated the links and changed the Excel.Sheet.8 part to Workbook, as it should have.

So... The solution, I think, is to open the .dot file, save it, save and close the beginning (template) xls file, open the new xls file, then open the new doc file. Both template files are closed. Both resultant "working" files are open. Then, run whatever the code is to update all fields. Can't recall that code, but I think it is on here somewhere.

Note: I also had to rearrange the flow of what you had posted. I don't know if it mattered or not, but putting the "Work goes here" section (where it gets the file name of the .dot file to open) before the o.Word.Documents.Open part made it work. Here's the code in its latest and greatest form, without the additions I think will make it work:

Sub AssembleReport()
Dim sTemplates As String
Dim sSaveName As String
Dim sLookFor As String
Dim oField As Object
Dim oWord As Object
Set oWord = CreateObject("Word.Application")

'Get the location of the Template directory
With CreateObject("WScript.Shell")
sTemplates = .ExpandEnvironmentStrings("J:\REPORT RESOURCES\TEMPLATES\")
End With

'Get this workbook's network path (What Word looks for)
sLookFor = SDblSlash(SToNetworkName(ThisWorkbook.FullName))

'Get the name/location for saving
sSaveName = SToNetworkName(SGetLoc)

'Work goes here
SGetName = ActiveSheet.Range("G5").Value

'Open the template
With oWord.Documents.Open(sTemplates & SGetName)
oWord.Visible = True
'Update the field codes
For Each oField In .Fields
Application.StatusBar = "Updating field " & oField.Index
oField.Code.Text = Replace(oField.Code, sLookFor, """" & SDblSlash(sSaveName) & ".xls""", , , 1)
oField.Code.Text = Replace(oField.Code, SDblSlash(ThisWorkbook.FullName), "'" & SDblSlash(sSaveName) & ".xls""", , , 1)
oField.Code.Text = Replace(oField.Code, """""", """")
oField.Update
Next
Application.StatusBar = ""

'Saving our work
.SaveAs sSaveName & ".doc"
End With
ActiveWorkbook.SaveCopyAs sSaveName & ".xls"

'Cleanup
If Not oWord Is Nothing Then
oWord.Quit 0
Set oWord = Nothing
End If
End Sub

Private Function SGetLoc()
'Save dialog
SGetLoc = Application.GetSaveAsFilename()

'Remove any extension (I.E. .xls)
If InStrRev(SGetLoc, ".") Then _
SGetLoc = Left(SGetLoc, InStrRev(SGetLoc, ".") - 1)
End Function

Private Function SDblSlash(sIn As String)
SDblSlash = Replace(sIn, "\", "\\")
End Function

Private Function SToNetworkName(sIn As String)
Dim sName As String
Dim i As Integer
Dim cDrives As Object

sName = sIn
If Mid(sName, 2, 1) <> ":" Then
'Not a drive letter, mapped or otherwise
SToNetworkName = sName
Exit Function
End If

Set cDrives = CreateObject("WScript.Network").EnumNetworkDrives
With cDrives
For i = 0 To .Count - 1 Step 2
If InStr(1, Mid(sName, 1, 2), .Item(i), 1) And CBool(Len(.Item(i))) Then
'Found the network drive we're using
sName = .Item(i + 1) & Mid(sName, 3)
Exit For
End If
Next
End With
SToNetworkName = sName
End Function

I'm entirely unfamiliar with this stuff, but I'm learning as I go, so please bear with me.

First - what does "Option Explicit" do? Whenever I add it in, I get an "undefined" error.

Ok, here's what I've got thus far:

Sub AssembleReport()
Dim sTemplates As String
Dim sSaveName As String
Dim sLookFor As String
Dim oField As Object
Dim oWord As Object
Set oWord = CreateObject("Word.Application")

'Get the location of the Template directory
With CreateObject("WScript.Shell")
sTemplates = .ExpandEnvironmentStrings("J:\REPORT RESOURCES\TEMPLATES\")
End With

'Get this workbook's network path (What Word looks for)
sLookFor = SDblSlash(SToNetworkName(ThisWorkbook.FullName))

'Get the name/location for saving
sSaveName = SToNetworkName(SGetLoc)
ActiveWorkbook.SaveCopyAs sSaveName & ".xls"

'Work goes here
SGetName = ActiveSheet.Range("G5").Value

'Open the Word template
With oWord.Documents.Open(sTemplates & SGetName)
oWord.Visible = True

'Update the field codes in new Word document (working document)
For Each oField In .Fields
Application.StatusBar = "Updating field " & oField.Index
oField.Code.Text = Replace(oField.Code, sLookFor, """" & SDblSlash(sSaveName) & ".xls""", , , 1)
oField.Code.Text = Replace(oField.Code, SDblSlash(ThisWorkbook.FullName), "'" & SDblSlash(sSaveName) & ".xls""", , , 1)
oField.Code.Text = Replace(oField.Code, """""", """")
oField.Update
Next
Application.StatusBar = ""

'Saving our work
.SaveAs sSaveName & ".doc"

End With

'Open the new Excel document (working document)

'???

'Open the new Word document (working document)

'???

'Cleanup
If Not oWord Is Nothing Then
oWord.Quit 0
Set oWord = Nothing
End If
End Sub

Private Function SGetLoc()
'Save dialog
SGetLoc = Application.GetSaveAsFilename()

'Remove any extension (I.E. .xls)
If InStrRev(SGetLoc, ".") Then _
SGetLoc = Left(SGetLoc, InStrRev(SGetLoc, ".") - 1)
End Function

Private Function SDblSlash(sIn As String)
SDblSlash = Replace(sIn, "\", "\\")
End Function

Private Function SToNetworkName(sIn As String)
Dim sName As String
Dim i As Integer
Dim cDrives As Object

sName = sIn
If Mid(sName, 2, 1) <> ":" Then
'Not a drive letter, mapped or otherwise
SToNetworkName = sName
Exit Function
End If

Set cDrives = CreateObject("WScript.Network").EnumNetworkDrives
With cDrives
For i = 0 To .Count - 1 Step 2
If InStr(1, Mid(sName, 1, 2), .Item(i), 1) And CBool(Len(.Item(i))) Then
'Found the network drive we're using
sName = .Item(i + 1) & Mid(sName, 3)
Exit For
End If
Next
End With
SToNetworkName = sName
End Function

That does just about everything. ONLY problem is sometimes it "hangs" the excel file in memory and I can't open it without rebooting. Is there a way to clear out all of the memory (dims, sets, etc.)? Ever since I've started doing this, I cannot open Excel or Doc files from Explorer - I have to open each app, then browse for the file. Can't figure out why - memory thing?

I would like to, at the end of all of this, "finish off" the code by closing down the original xls file that I started with, and then FIRST open up the new Excel file (sName.xls) and then the new Doc file (sName.doc). I've tried a couple of combinations from what little I know about this stuff, but I can't get all three things to do right.

Any help is much appreciated.

Thanks again,

Hoop

what does "Option Explicit" do?
It forces you to explicitly define your variables. It helps with debugging. A lot. (Nothing like spending an hour trying to find out why this chunk of code doesn't work, just to find out you swapped two keys on a variable a few lines ago.)

sometimes it "hangs" the excel file
That happens from time to time when debugging code like this. One option would be to open Task Manager and kill any excel.exe and winword.exe you see (in the Processes tab). If you're running WinXP Pro, there's an easy command you can use: taskkill /f /im excel.exe /im winword.exe

closing down the original xls file that I started with...open up the new Excel file...
The easier option would be to change our workbook save action to match the GUI's Save As behavior. To do this, we change the following line:
ActiveWorkbook.SaveCopyAs sSaveName & ".xls"
to:
ActiveWorkbook.SaveAs sSaveName & ".xls"

...and then the new Doc file (sName.doc).
Well, we already have it open. We just haven't made it visible. to do that, replace this line:
oWord.Quit 0
with:
oWord.Visible = True

You tha man!

Thanks a bunch!!

-Hoop