Disable AutoOpen macro after saving document

M

MAT

Hi,
I have a macro (below) that puts document
information in the header and footers of a document from an external
application which works
fine until the user saves the document then opens another document from

the same program when they subsequently reopen the first documnet it
now has the
second documents details in it which is what I want to stop! (The
information is written to the persons ini file on their C drive)
Is there any way to stop the macro from running once the document has
been saved? all the documents start with a name ~qw if thats any help.
The user can also open the documents from the intranet which doesn't
cause the same problem.


Sub nofooter()
'
With WordBasic
.NormalViewHeaderArea Type:=0
End With
'
End
End Sub
'


Sub HeaderLine()
'
Selection.HeaderFooter.Shapes.AddLine(93.6, 57.6, 504#,
57.6).Select
Selection.ShapeRange.Line.Weight = 2.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.RGB = RGB(128, 128, 128)
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)


End Sub
Sub footerlines()
'
Selection.HeaderFooter.Shapes.AddLine(93.6, 760#, 504#, 760#). _
Select
Selection.ShapeRange.Line.Weight = 3#
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.RGB = RGB(150, 150, 150)
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.RelativeVerticalPosition = _
wdRelativeVerticalPositionParagraph
'Second line !!
Selection.HeaderFooter.Shapes.AddLine(93.6, 780#, 504#, 780#). _
Select
Selection.ShapeRange.Line.Weight = 3#
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.RGB = RGB(150, 150, 150)
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.RelativeVerticalPosition = _
wdRelativeVerticalPositionParagraph
End Sub


Sub AutoOpen()
'
Dim MyDate
MyDate = Date ' MyDate contains the current system date.
With WordBasic
maxchar = 64


' modification D B 02/09/04 if document comes from IE then load
different INI file generated
If Left(Application.ActiveDocument.Name, 10) = "IEDownLoad" Then
Dim strIniName As String
strIniName = Left(Application.ActiveDocument.Name, 60) & ".ini"
Title$ = .[getPrivateProfileString$]("Document", "QWTitle",
"\\Appsrv2\QWBINI_Files\" & strIniName)
Ref$ = .[getPrivateProfileString$]("Document", "QWref",
"\\Appsrv2\QWBINI_Files\" & strIniName)
Rev$ = .[getPrivateProfileString$]("Document", "QWRev",
"\\Appsrv2\QWBINI_Files\" & strIniName)
Stat$ = .[getPrivateProfileString$]("Document", "QWStat",
"\\Appsrv2\QWBINI_Files\" & strIniName)
IDate$ = .[getPrivateProfileString$]("Document", "QWIssue",
"\\Appsrv2\QWBINI_Files\" & strIniName)
Typ$ = .[getPrivateProfileString$]("Document", "QWTYPE",
"\\Appsrv2\QWBINI_Files\" & strIniName)
Else
Title$ = .[getPrivateProfileString$]("Document", "QWTitle",
"qwcs.ini")
Ref$ = .[getPrivateProfileString$]("Document", "QWref", "qwcs.ini")

Rev$ = .[getPrivateProfileString$]("Document", "QWRev", "qwcs.ini")

Stat$ = .[getPrivateProfileString$]("Document", "QWStat",
"qwcs.ini")
IDate$ = .[getPrivateProfileString$]("Document", "QWIssue",
"qwcs.ini")
Typ$ = .[getPrivateProfileString$]("Document", "QWTYPE",
"qwcs.ini")
End If
'
' Get next issue date from RC ini file
NIDate$ = .[getPrivateProfileString$]("Document", "Nissue",
"\\appsrv1\qwb_pro\master\RC.ini")
'
End With
' check for short or long date format
Dim Findspace
Findspace = Mid(IDate$, 9, 1)
If Findspace = " " Then IDate$ = Left(IDate$, 8) Else IDate$ =
Left(IDate$, 10)
'
' Check to see if document status is ISSUED
Dim Issuestatus
Issuestatus = Mid(Stat$, 1, 6)
If Issuestatus <> "ISSUED" Then IDate$ = ""
'
With WordBasic
With ActiveDocument.PageSetup
'
.FooterDistance = 35
End With
header:
..StartOfDocument
..NormalViewHeaderArea Type:=0
..EditSelectAll
..WW6_EditClear
..Font "Arial"
..FormatFont Points:=14, Bold:=1, Italic:=0, Color:=0
..Insert " " + Title$
Call HeaderLine
'.StartOfDocument
'
footer:
'.StartOfDocument
..NormalViewHeaderArea Type:=0
..Font "Arial"
..NormalViewHeaderArea Type:=1
..EditSelectAll
..WW6_EditClear
..Font "Arial"
..FormatFont Points:=8, Bold:=0, Italic:=1, Color:=0
..InsertPara
'
'Can't use word basic for this
End With
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
'
' check to see if the document is a form, and if it is then exit !
'
'If Typ$ = "Form (F)" Then Call nofooter Else
With WordBasic
.Insert "Document administered by WPro. Uncontrolled copies valid
until the next document issue on " + NIDate$
.InsertPara
.InsertPara
'.CharRight 100
.Font "Arial"
.FormatFont Points:=8, Bold:=1, Italic:=0, Color:=0
.Insert "HFL " + Ref$
.Insert Chr(9) + "Revision " + Rev$
.Insert Chr(9) + "Page Number "
.InsertField Field:="page \*arabic"
.Insert " of "
.InsertField Field:="numpages"
.CharRight 10
.InsertPara
.Insert "Status: " + Stat$ + " (" + IDate$ + ")"
.Insert Chr(9) + "Issuing Authority: System Administrator"
.Insert Chr(9) + "Date Printed "
Selection.InsertDateTime
Call footerlines
.NormalViewHeaderArea Type:=0
End With
End Sub
 
D

Dave Lett

Hi MAT,

Most often, you shouldn't start a new thread for a topic that is in
discussion. But this time, your new message gives some new clues. You're
running this on AutoOpen. Do you want it to be on AutoNew?

Maybe not. Perhaps you could use the Range object and overwrite the contents
of the header/footer each time?

Dave

MAT said:
Hi,
I have a macro (below) that puts document
information in the header and footers of a document from an external
application which works
fine until the user saves the document then opens another document from

the same program when they subsequently reopen the first documnet it
now has the
second documents details in it which is what I want to stop! (The
information is written to the persons ini file on their C drive)
Is there any way to stop the macro from running once the document has
been saved? all the documents start with a name ~qw if thats any help.
The user can also open the documents from the intranet which doesn't
cause the same problem.


Sub nofooter()
'
With WordBasic
.NormalViewHeaderArea Type:=0
End With
'
End
End Sub
'


Sub HeaderLine()
'
Selection.HeaderFooter.Shapes.AddLine(93.6, 57.6, 504#,
57.6).Select
Selection.ShapeRange.Line.Weight = 2.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.RGB = RGB(128, 128, 128)
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)


End Sub
Sub footerlines()
'
Selection.HeaderFooter.Shapes.AddLine(93.6, 760#, 504#, 760#). _
Select
Selection.ShapeRange.Line.Weight = 3#
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.RGB = RGB(150, 150, 150)
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.RelativeVerticalPosition = _
wdRelativeVerticalPositionParagraph
'Second line !!
Selection.HeaderFooter.Shapes.AddLine(93.6, 780#, 504#, 780#). _
Select
Selection.ShapeRange.Line.Weight = 3#
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.RGB = RGB(150, 150, 150)
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.RelativeVerticalPosition = _
wdRelativeVerticalPositionParagraph
End Sub


Sub AutoOpen()
'
Dim MyDate
MyDate = Date ' MyDate contains the current system date.
With WordBasic
maxchar = 64


' modification D B 02/09/04 if document comes from IE then load
different INI file generated
If Left(Application.ActiveDocument.Name, 10) = "IEDownLoad" Then
Dim strIniName As String
strIniName = Left(Application.ActiveDocument.Name, 60) & ".ini"
Title$ = .[getPrivateProfileString$]("Document", "QWTitle",
"\\Appsrv2\QWBINI_Files\" & strIniName)
Ref$ = .[getPrivateProfileString$]("Document", "QWref",
"\\Appsrv2\QWBINI_Files\" & strIniName)
Rev$ = .[getPrivateProfileString$]("Document", "QWRev",
"\\Appsrv2\QWBINI_Files\" & strIniName)
Stat$ = .[getPrivateProfileString$]("Document", "QWStat",
"\\Appsrv2\QWBINI_Files\" & strIniName)
IDate$ = .[getPrivateProfileString$]("Document", "QWIssue",
"\\Appsrv2\QWBINI_Files\" & strIniName)
Typ$ = .[getPrivateProfileString$]("Document", "QWTYPE",
"\\Appsrv2\QWBINI_Files\" & strIniName)
Else
Title$ = .[getPrivateProfileString$]("Document", "QWTitle",
"qwcs.ini")
Ref$ = .[getPrivateProfileString$]("Document", "QWref", "qwcs.ini")

Rev$ = .[getPrivateProfileString$]("Document", "QWRev", "qwcs.ini")

Stat$ = .[getPrivateProfileString$]("Document", "QWStat",
"qwcs.ini")
IDate$ = .[getPrivateProfileString$]("Document", "QWIssue",
"qwcs.ini")
Typ$ = .[getPrivateProfileString$]("Document", "QWTYPE",
"qwcs.ini")
End If
'
' Get next issue date from RC ini file
NIDate$ = .[getPrivateProfileString$]("Document", "Nissue",
"\\appsrv1\qwb_pro\master\RC.ini")
'
End With
' check for short or long date format
Dim Findspace
Findspace = Mid(IDate$, 9, 1)
If Findspace = " " Then IDate$ = Left(IDate$, 8) Else IDate$ =
Left(IDate$, 10)
'
' Check to see if document status is ISSUED
Dim Issuestatus
Issuestatus = Mid(Stat$, 1, 6)
If Issuestatus <> "ISSUED" Then IDate$ = ""
'
With WordBasic
With ActiveDocument.PageSetup
'
.FooterDistance = 35
End With
header:
..StartOfDocument
..NormalViewHeaderArea Type:=0
..EditSelectAll
..WW6_EditClear
..Font "Arial"
..FormatFont Points:=14, Bold:=1, Italic:=0, Color:=0
..Insert " " + Title$
Call HeaderLine
'.StartOfDocument
'
footer:
'.StartOfDocument
..NormalViewHeaderArea Type:=0
..Font "Arial"
..NormalViewHeaderArea Type:=1
..EditSelectAll
..WW6_EditClear
..Font "Arial"
..FormatFont Points:=8, Bold:=0, Italic:=1, Color:=0
..InsertPara
'
'Can't use word basic for this
End With
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
'
' check to see if the document is a form, and if it is then exit !
'
'If Typ$ = "Form (F)" Then Call nofooter Else
With WordBasic
.Insert "Document administered by WPro. Uncontrolled copies valid
until the next document issue on " + NIDate$
.InsertPara
.InsertPara
'.CharRight 100
.Font "Arial"
.FormatFont Points:=8, Bold:=1, Italic:=0, Color:=0
.Insert "HFL " + Ref$
.Insert Chr(9) + "Revision " + Rev$
.Insert Chr(9) + "Page Number "
.InsertField Field:="page \*arabic"
.Insert " of "
.InsertField Field:="numpages"
.CharRight 10
.InsertPara
.Insert "Status: " + Stat$ + " (" + IDate$ + ")"
.Insert Chr(9) + "Issuing Authority: System Administrator"
.Insert Chr(9) + "Date Printed "
Selection.InsertDateTime
Call footerlines
.NormalViewHeaderArea Type:=0
End With
End Sub
Click to expand...
 
M

MAT

I've tried the AutoNew command instead of Open and it stops the macro
running altogether the documents are opened from a document management
system so they are already saved documents I wondered if something like
" if document.name like "~qw*" then disable macro else run autoopen"
would work but I don't know how to write that into the macro (not my
area of expertise I'm afraid)
 
D

Dave Lett

MAT,
I'm thinking that disabling that macro isn't the right approach because it
will most likely disable/remove it from the template that you're using, which
means that subsequent users wouldn't have access to it either.
Perhaps if we understood the process a little better, we'd be able to come
up with a solution. Therefore, can you provide a numbered list of what the
user does and what the macro does and when? For example,

1. User opens or creates new document (let's call it docA) from shell
application?
2. shell application writes the header/footer to the opened document.
3. User saves and closes docA.
4. User reopens docA and shell application OVERwrites existing header/footer?
a. stop shell application from overwriting existing header/footer?

If there is another condition, can you explain it in the same way?

Dave
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

resize table with macro 1
pasting into Word... 0

Top