Macro, take the document name as a value and offset to print off the document

[francozola25]

Hi i was wondering if someone could help me i currently have a macro whereby
a userform will appear. I enter a number in the field on the user form and
click insert. This will then update the textfield in every page of my
document. Please see below what the macro is currently.



Sub Update()

Dim Title As String
Dim frmTitle As UserForm1
Dim oStory As Range

Set frmTitle = New UserForm1

With frmTitle
.Show
ActiveDocument.BuiltInDocumentProperties("Title").Value = .Title.Text
End With

Unload frmTitle

Set frmTitle = Nothing

For Each oStory In ActiveDocument.StoryRanges
oStory.Fields.Update
If oStory.StoryType < wdMainTextStory Then
While Not (oStory.NextStoryRange Is Nothing)
Set oStory = oStory.NextStoryRange
oStory.Fields.Update
Wend
End If
Next oStory
Set oStory = Nothing
End Sub

I want to add on to my current macro in the following way! When the update of fields has completed i want to LookIn into an excel file in a specified location. Match the number which is the xxx.doc with a file in column B. Then take the value in cell reference of column B and open a file as follows G:\Forms\B$, enter Title into textfield and print off. Please view step by step guide:

-> .LookIn = Change path G:\Forms\
-> .Filename = ?Index.xls?
-> Search Worksheet for column A (based on the file name of current
document opened- eg. The current file might be 00308.doc) to offset as to
column B to find correct value. $VariableName
-> Take the cell reference of column B and Open this file =
G:\Forms\$VariableName
-> Enter Title Value into textfield and print.

[Tinbendr]

I cobbled this together from some code I use.

Not tested at all.

You'll have to set the Excel reference in the Word VBE.

Better to add a module. At the end of the click event add;

Set oStory = Nothing
SheetPrintOut
End Sub

Sub SheetPrintOut()
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oWB2 As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim c As Excel.Range
Dim ExcelWasNotRunning As Boolean
Dim WorkbookToWorkOn As String
Dim WordFN As String
Dim ExcelFN As String
'Word document name without extension 00308.doc = 00308
WordFN = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 4)
WorkbookToWorkOn = "G:\forms\index.xls"
'If Excel is running, get a handle on it; otherwise start a new instance of Excel
On Error Resume Next
Set oXL = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
ExcelWasNotRunning = True
Set oXL = New Excel.Application
End If
On Error GoTo Err_Handler
'If you want Excel to be visible, you could add the
'line: oXL.Visible = True here; but your code will
'run faster if you don't make it visible
'Open the workbook
Set oWB = oXL.Workbooks.Open(FileName:=WorkbookToWorkOn)
Set oSheet = oWB.Worksheets(1)
'Find last cell with data in column A.
RowI = oSheet.Cells(oSheet.Rows.Count, "A").End(xlUp).Row
With oSheet.Range("a1:a" & RowI)
Set c = .Find(WordFN, LookIn:=xlValues)
If Not c Is Nothing Then
ExcelFN = c.Offset(0, 1).Value
'You didn't state whether the file to open is Word or Excel.
'I assumed Excel.
Set oWB2 = oXL.Workbooks.Open("G:\Forms\" & ExcelFN)
oWB2.PrintOut
oWB2.Close savechanges:=False
Else
MsgBox ("File not found")
End If
End With

If ExcelWasNotRunning Then
oXL.Quit
Else
oWB.Close
End If
'Make sure you release object references.
Set oRng = Nothing
Set oSheet = Nothing
Set oWB = Nothing
Set oXL = Nothing
'quit
Exit Sub
Err_Handler:
MsgBox WorkbookToWorkOn & " caused a problem. " & Err.Description, vbCritical, "Error: " _
& Err.Number
If ExcelWasNotRunning Then
oXL.Quit
End If
Set oRng = Nothing
Set oSheet = Nothing
Set oWB = Nothing
Set oXL = Nothing

End Sub

[francozola25]

Thanks for that Tinbendr

Quick question there can be several printouts related to the extension.ie. 00308.doc can be find a number of times in column A. I wish to print off every file in column B that has 00308.doc to its left.

It is Word that i would like open rather than excel. Just what i want to do at the end is enter in the variable value for Title. As you can see from my above macro. I have formfields rename as Title and i have Value entered in here. What is i want i to put this Value in a Title formfield in the printed off document. All my documents will have a Title formfields in them before opening, it just needs the inputted value from the userform.

[Tinbendr]

I'm still unclear about the Title. Do you want to take the Title from aDoc (Activedocument) and send it to the aDoc(Printout Document)?

Is the field in the bDoc that holds the Title actually a text formfield on the document?

if yes to both, then maybe...
Sub Update()
Dim Title As String
Dim frmTitle As UserForm1
Dim oStory As Range
Set frmTitle = New UserForm1
With frmTitle
.Show
ActiveDocument.BuiltInDocumentProperties("Title").Value = .Title.Text
End With
Unload frmTitle
Set frmTitle = Nothing
Call UpdateStoryRanges(ActiveDocument)
Call SheetPrintOut
End Sub
Sub SheetPrintOut()
Dim aDoc As Document
Dim bDoc As Document
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oWB2 As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim c As Excel.Range
Dim FirstAddress As String
Dim ExcelWasNotRunning As Boolean
Dim WorkbookToWorkOn As String
Dim WordFN As String
Dim ExcelFN As String

Set aDoc = ActiveDocument
'Word document name without extension 00308.doc = 00308
WordFN = Left(aDoc.Name, Len(aDoc.Name) - 4)
WorkbookToWorkOn = "G:\forms\index.xls"
'If Excel is running, get a handle on it; otherwise start a new instance of Excel
On Error Resume Next
Set oXL = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
ExcelWasNotRunning = True
Set oXL = New Excel.Application
End If
On Error GoTo Err_Handler
'If you want Excel to be visible, you could add the
'line: oXL.Visible = True here; but your code will
'run faster if you don't make it visible
'Open the workbook
Set oWB = oXL.Workbooks.Open(FileName:=WorkbookToWorkOn)
Set oSheet = oWB.Worksheets(1)
'Find last cell with data in column A.
RowI = oSheet.Cells(oSheet.Rows.Count, "A").End(xlUp).Row
With oSheet.Range("a1:a" & RowI)
Set c = .Find(WordFN, LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
ExcelFN = c.Offset(0, 1).Value
'Open and print linked doc.
Set bDoc = Documents.Open("G:\Forms\" & ExcelFN)
bDoc.FormFields("Title").Result = _
aDoc.BuiltInDocumentProperties("Title")
Call UpdateStoryRanges(bDoc)
bDoc.PrintOut
bDoc.Close savechanges:=False

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
Else
MsgBox ("File not found")
End If
End With

If ExcelWasNotRunning Then
oXL.Quit
Else
oWB.Close
End If
'Make sure you release object references.
Set oRng = Nothing
Set oSheet = Nothing
Set oWB = Nothing
Set oXL = Nothing
'quit
Exit Sub
Err_Handler:
MsgBox WorkbookToWorkOn & " caused a problem. " & Err.Description, vbCritical, "Error: " _
& Err.Number
If ExcelWasNotRunning Then
oXL.Quit
End If
Set oRng = Nothing
Set oSheet = Nothing
Set oWB = Nothing
Set oXL = Nothing

End Sub
Sub UpdateStoryRanges(CurrentDoc As Document)
For Each oStory In CurrentDoc.StoryRanges
oStory.Fields.Update
If oStory.StoryType < wdMainTextStory Then
While Not (oStory.NextStoryRange Is Nothing)
Set oStory = oStory.NextStoryRange
oStory.Fields.Update
Wend
End If
Next oStory
Set oStory = Nothing
End Sub

[francozola25]

Thanks for all your assistance with this

Yes that is exactly what i want to do! On my current aDoc, i have formfields but have renamed them as Title. When the macro is run, it will take the document name to see if there any forms associated with it in the index.xls. When found it will offset to ExcelFN open bDoc(there may be more as aDoc document name might have more than 1 form associated with it in index.xls. I want to open dDoc and insert the same Title into the form(or each of the forms if there is more) and then print these out.

I tried your code but just as it open one the bDoc files, i am presented with an Error:5941 G:\Forms\index.xls caused a problem. The requested member of the collection does not exist.

I have put a textfield in the form and renamed it as Title but still no luck.

[Tinbendr]

I tried your code but just as it open one the bDoc files, i am presented with an Error:5941 G:\Forms\index.xls caused a problem. The requested member of the collection does not exist.Is the name of the file in Column B a full document name? In other words, is it FORM1234.DOC, or does it simply have FORM1234? If the latter, then we'll have to add the extension.
Set bDoc = Documents.Open("G:\Forms\" & ExcelFN & ".doc")

If it's loading the file, then put in a stopbreak (Debug->Toggle Stopbreak) after that, say on the linebDoc.FormFields("Title").Result = _
aDoc.BuiltInDocumentProperties("Title")
Step through the code (F8) to see what line it's stopping on.

[francozola25]

Every thing is okay with the .doc extension

It happens on these lines


bDoc.FormFields("Title").Result = _
aDoc.BuiltInDocumentProperties("Title")

As soon as i step part these i get

Error: 5941
G:\forms\index.xls caused a problem. The requested member of the collection does not exist.

[Tinbendr]

Ok, first, let's modify the error msgbox. It was throwing me off.

Change
MsgBox WorkbookToWorkOn & " caused a problem. " & Err.Description, vbCritical, "Error: " _
& Err.Number
to
MsgBox Err.Description, vbCritical, "Error: " & Err.Number
My guess is the formfield don't exist on the bDoc.

change
bDoc.FormFields("Title").Result = _
aDoc.BuiltInDocumentProperties("Title")
to (Actually, just comment the long line and add these two lines.)
bDoc.FormFields("Title").Result = "Test Message"
Temp$ = aDoc.BuiltInDocumentProperties("Title")

Step through these again and see where it errors.

[francozola25]

Hey

No just getting a message saying Error: 5941
The requested member of the collection does not exist.

It will open the bDoc and the error flashes up there. I toggle through and it is doing exactly the same as before. I tried putting the message in and it doesn't work.

It wouldn't be a problem with the excel file and opening the document. It is opening the document, only after that does the message appear

Thanks

[Tinbendr]

So when the programs errors, the line that is highlighted is bDoc.FormFields("Title").Result = "Test Message"

If so, then the formfield doesn't exist in the bDoc or is named incorrectly.

Just to clarify, a formfield and builtinDocumentProperties are different.

Maybe we should just bDoc.builtindocumentproperties("Title") = _
aDoc.builtindocumentproperties("Title")But you will still have to insert the title field into the bDoc before hand.

[francozola25]

Hey

Yeah i put in that code as follows

Set bDoc = Documents.Open("G:\forms\" & ExcelFN)

bDoc.builtindocumentproperties("Title") = _
aDoc.builtindocumentproperties("Title")
Call UpdateStoryRanges(bDoc)
bDoc.Print

It actually does update but stops with the following error

Error:438 Object doesn't support this property or method

meaning it will not open the next document that is associated with ExcelFn or print the document.

[Tinbendr]

Should be bDoc.PrintOut
bDoc.Close savechanges:=wdDoNotSaveChanges
I assume you don't want to save changes.... If not then, bDoc.Close savechanges:=wdSaveChanges

[francozola25]

Works Brillant

I cannot thank you enough for all your help!

[francozola25]

Hi again Tinbendr,

Just a quick one, i was wondering if there is such a way that can i offset more than one time here. Sometimes WordFn might refer to more than one form,so c.Offset (0, 1) , c.Offset (0, 2)... and so on. Some might have 2 others have 4 forms. Is there a way i could tell it that if the next is empty stop other keep offsetting and opening these forms.

Thanks

[Tinbendr]

Try this.

Dim aCol as Integer
Do
Do
aCol = aCol + 1
ExcelFN = c.Offset(0, aCol).Value
'Open and print linked doc.
If ExcelFN <> "" Then
Set bDoc = Documents.Open("G:\Forms\" & ExcelFN)
bDoc.FormFields("Title").Result = _
aDoc.BuiltInDocumentProperties("Title")
Call UpdateStoryRanges(bDoc)
bDoc.PrintOut
bDoc.Close savechanges:=False
End If
Loop Until ExcelFN = ""

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress

[francozola25]

Brilliant

As a close out to this would there be much to do to call a userform, stating the WordFN along with all the ExcelFN forms?

[Tinbendr]

Dim ExFnList As String
Do
Do
aCol = aCol + 1
ExcelFN = c.Offset(0, aCol).Value
ExFnList = ExFnList & ExcelFN & vbCr
'Open and print linked doc.
If ExcelFN <> "" Then
Set bDoc = Documents.Open("G:\Forms\" & ExcelFN)
bDoc.FormFields("Title").Result = _
aDoc.BuiltInDocumentProperties("Title")
Call UpdateStoryRanges(bDoc)
bDoc.PrintOut
bDoc.Close savechanges:=False
End If
Loop Until ExcelFN = ""

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
MsgBox (WordFN & vbCr & ExFnList)
Else
MsgBox ("File not found")
End If

[francozola25]

Excellent

Rather than a msgbox, i am trying to show the data on a userform like so


With UserForm2
.TextBox1 = " Document " & WordFN & " has the following forms attached: " & vbCr & Replace(ExFnList, "|", vbCr)
.Show


I cannot get it go to the next line for ExFnList, even though the form is TextBox1 has wrap text set as true.

[Tinbendr]

I think the linefeed in a userform textbox is Chr(10).

If that doesn't work, try vbCrLF.

(BTW, I changed the code a little after I first posted it. I removed the Replace function as it's really not needed. But, whatever works.)

[francozola25]

Excellent

I have it working with the userform now. I know you are probably sick of my by now but i was wondering would it be hard offsetting over a blank cell into a column with a form name in.

What happens as you know it finds WordFn in columnA then offsets. Can it offset as far as columnH. Some Documents might have forms in column B but might not have it in column C and could again have in column D. I want to be able to jump over this a cell if it blank till it reaches columnH. Each documents (WordFn) have different forms associated with them

I know currently this is being used which is great but sometimes it might have column B empty then C with something in it if you know what i mean

Do
aCol = aCol + 1
ExcelFN = c.Offset(0, aCol).Value
''
'
'
Loop Until ExcelFN = ""



thanks again for all your help

[francozola25]

I had tried


Loop Until ExcelFN = c.Offset(0, 6).Value


But when there is an empty cell it stops at that, it will not print the form after empty

[Tinbendr]

Change the loop counter.

This will force the count out to H.

Change Loop Until ExcelFN = "" to
Loop Until aCol = 8

The If-Then will skip any that are empty.

[francozola25]

Brillant i have that. Thanks

Could i ask a final thing. Application.Screenupdating = False does not seem to work. It still show the steps going through the macro which i do not want. I have tried putting in oXL.Screenupdating = False and oDoc.Screenupdating = False and still no luck.

[Tinbendr]

I have never had much luck with Application.Screenupdating totally suppressing screen activity. It's hit or miss.

On the Excel side, you might try to set the visible.
oXL.Visible = False
'or
oXL.Application.WindowState = xlMinimized

[francozola25]

Yeah it is just a nice to have. Thanks for all your help