Solved

Memory Problem Word Form

Posted on 2004-09-14
9
359 Views
Last Modified: 2008-02-01
Anyone have any experience with memory leaks and Word Forms?  When I open a Word document with my macros, the memory usage for winword skyrockets... and eventually crashes Word.  Any way to reset that other than shutting down word and restarting?

Ask any questions you need to... this territory is very unfamiliar to me and I don't know what information to provide to determine why I have this memory problem...

0
Comment
Question by:epuglise
  • 3
  • 3
  • 2
  • +1
9 Comments
 
LVL 3

Expert Comment

by:Sasho
ID: 12056806
Can you post your code? Maybe there is a memory leak in it....
0
 
LVL 22

Assisted Solution

by:Dreamboat
Dreamboat earned 250 total points
ID: 12057407
Does this happen with the code?

If not...

Export your modules.
Save your file as RTF.
Close it.
Reopen the RTF.
SAve it as a DOC.
Import the modules.
0
 

Author Comment

by:epuglise
ID: 12058104
DreamBoat:

I'll give that a try!!

Thanks

Sasho:
I wouldn't even know what a memory leak in my code looked like.  The computer's not dripping, so I thought everything was ok!!  ;)  If you know what to look for and find a leak that keeps me from crashing, I'll add points (I'm a paying member, so I hand 'em out generously!)

You asked for it...

Const TAILORINGFOLDER = "Tailoring_Area"
Const REDLINEFOLDER = "Redlined_Versions"
Const PROJECTFOLDER = "Project_Enabler"
Const MASTERFOLDER = "Enabler"
Const ENDOFTEXTMARKER = "~~THE END~~"
Const LASTFIELDMARKER = "END"

'**********************************************************
'* THIS CODE IS REQUIRED FOR CONVERSION AND BY END USERS  *
'**********************************************************
Sub CreateRationaleTextField()

    'Debug.Print "Now entering: CreateRationaleTextField"
    Set dd_Rationale = Selection.FormFields.Add( _
        Range:=Selection.Range, Type:=wdFieldFormTextInput)
   
    With dd_Rationale
        .Name = "Rationale"
        .HelpText = "Insert your rationale here."
        .TextInput.Width = 512
    End With
   
End Sub

Sub CreateStatementField()
'Debug.Print "Now entering: CreateStatementField"
'
' CreateStatementField Macro
'  by

Dim OrigGuideText As String

'THIS NEEDS TO BE CHANGED!!!:  IT TRUNCATES TEXT!
'OrigGuideText = Left(Selection.Range.Text, 255)
OrigGuideText = Selection.Range.Text
Debug.Print "This is origguidetext: " & OrigGuideText
Debug.Print Len(OrigGuideText)
If Len(OrigGuideText) <= 255 Then
    Debug.Print "Len is <= 255"
    Selection.FormFields.Add Range:=Selection.Range, Type:= _
        wdFieldFormTextInput
    Selection.PreviousField.Select
    With Selection.FormFields(1)
        .Name = "Statement"
        .EntryMacro = ""
        .ExitMacro = ""
        .Enabled = True
        .OwnHelp = True
        .HelpText = OrigGuideText
        .OwnStatus = False
        .StatusText = ""
        .TextInput.Width = 512
        .TextInput.EditType Type:=wdRegularText, Default:=OrigGuideText, Format:=""
    End With
    'Selection.Comments.Add Range:=Selection.Range
    'Selection.TypeText Text:=OrigGuideText
Else
    Debug.Print "I'm in the else"
    Dim NumLoops As Integer
    NumLoops = (Len(OrigGuideText) / 255) + 1
    Debug.Print NumLoops
    Dim Counter As Integer
    Dim CurrText As String
    Counter = 1
    Do While Counter <= NumLoops
        CurrText = Left(OrigGuideText, 255)
        Debug.Print "CurrText = " & CurrText
       
    Selection.FormFields.Add Range:=Selection.Range, Type:= _
    wdFieldFormTextInput
    Selection.PreviousField.Select
    With Selection.FormFields(1)
        .Name = "Statement"
        .EntryMacro = ""
        .ExitMacro = ""
        .Enabled = True
        .OwnHelp = True
        .HelpText = CurrText
        .OwnStatus = False
        .StatusText = ""
        .TextInput.Width = 512
        .TextInput.EditType Type:=wdRegularText, Default:=CurrText, Format:=""
    End With
    Selection.MoveRight unit:=wdCell, Count:=1
    Selection.MoveLeft unit:=wdCell
    Selection.MoveRight unit:=wdCharacter
    OrigGuideText = Mid$(OrigGuideText, 256)
    Counter = Counter + 1
    'Selection.Comments.Add Range:=Selection.Range
    'Selection.TypeText Text:=OrigGuideText
    Loop
    Selection.GoTo What:=wdGoToField, Which:=wdGoToPrevious, Count:=1

End If
   
End Sub
'*******************************************
'* END OF CODE THAT IS REQUIRED FOR        *
'* CONVERSION AND BY END USERS             *
'*******************************************

'*******************************************
'* THIS CODE IS FOR CONVERTING ENABLER     *
'* DOCUMENTS INTO TAILORING TOOLS.         *
'*******************************************
Sub ACreateTailoringReport()
Debug.Print "Now entering: CreateTailoringReport"
'
' CreateTailoringReport Macro
'  by
'

    'This is just a reminder to the conversion person:
    Dim Response
    Response = MsgBox("Have you checked for and eliminated hyperlinks?", 4, "REMINDER!")
    If Response = vbNo Then
        Exit Sub
    End If
   
    'THIS IS A TEMPORARY ITEM SEE MODULE HEADER FOR MORE INFO
    'NOTE that for this to work, the paragraph markers must be
    'VISIBLE!
    RemoveHiddenText
   
    'Make the Table:
    MakeTable
   
    'Create Rationale Column/Fields
    InsertRationaleFields
   
    'Label Tailoring Type Column and Create Guidance DropDowns
    InsertGuideDropDown
   
    'Create end of document bookmark
    InsertEndMark
   
    'Replace Guidance DropDowns with Requirements DropDowns for SPP statements.
    '  There are SPP statements with "{" and with "("
    FindRequiredItems1
    FindRequiredItems2
   
    'Delete input fields for Headings and Intro Text
    DeleteIntroSectionFields
   
    'Replace Guidance Statements with form fields
    'This needs to be fixed for text longer than 255 char
    FindGuidanceUpdateStatement
   
    'Delete the end-of-document markers:
    RemoveEndMarks
   
    'Insert Filename/Path autotext for future reference
    '    NormalTemplate.AutoTextEntries("Filename and path").Insert Where:= _
            Selection.Range
   
   
End Sub

Sub RemoveHiddenText()
'
' RemoveBadStuff Macro
' by
' This is to remove hidden text from draft (test) documents
' the final documents shouldn't have any hidden text... might have some hyperlinks

    With Selection.Find
        .ClearFormatting
        .Font.Hidden = True
        .Replacement.ClearFormatting
        .Replacement.Font.Hidden = False
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
    End With
   
End Sub

Sub MakeTable()
    With Selection
        .WholeStory
        .ConvertToTable Separator:=wdSeparateByParagraphs ', NumColumns:=1, _
             NumRows:=409, Format:=wdTableFormatNone, ApplyBorders:=True, _
            ApplyShading:=True, ApplyFont:=True, ApplyColor:=True, ApplyHeadingRows:= _
            True, ApplyLastRow:=False, ApplyFirstColumn:=True, ApplyLastColumn:=False _
            , AutoFit:=True, AutoFitBehavior:=wdAutoFitContents
        .InsertColumns
        .Style = ActiveDocument.Styles("Normal")
        .Columns.PreferredWidthType = wdPreferredWidthPoints
        .Columns.PreferredWidth = InchesToPoints(2.5)
        .InsertColumns
        .Style = ActiveDocument.Styles("Normal")
        .Tables(1).AutoFitBehavior (wdAutoFitContent)
        .Columns.PreferredWidthType = wdPreferredWidthPoints
        .Columns.PreferredWidth = InchesToPoints(1)
       
        .MoveUp unit:=wdLine, Count:=1
        .InsertRowsAbove 1
        .MoveLeft unit:=wdCharacter, Count:=1
        .MoveRight unit:=wdCell
        .MoveRight unit:=wdCell
        .TypeText Text:="Statement"
        .MoveRight unit:=wdCell
   
        'Return to top of doc
        .WholeStory
        .MoveLeft unit:=wdCharacter, Count:=1
    End With

End Sub

Sub InsertRationaleFields()
Debug.Print "Now entering: InsertRationaleFields"
'
' InsertRationaleFields Macro
'  by

    With Selection
        'Go to the top of the doc:
        .WholeStory
        .MoveLeft unit:=wdCharacter, Count:=1
       
        'Move to Rationale Column:
        .MoveRight unit:=wdCell
    End With
       
    'Create one instance of the Rationale Field
    CreateRationaleTextField
   
    With Selection
        'Copy the text field...
        .SelectCell
        .Copy
       
        '...then paste copies of the field in the entire column.
        .SelectColumn
        .Paste
        .MoveUp unit:=wdLine, Count:=1
        .Delete unit:=wdCharacter, Count:=1
    End With
   
End Sub

Sub InsertGuideDropDown()
Debug.Print "Now entering: InsertGuideDropDown"
'
' InsertReqDropDown Macro
'  by
'
    Selection.WholeStory
    Selection.MoveLeft unit:=wdCharacter, Count:=1
   
    Set dd_Guide = Selection.FormFields.Add(Range:=Selection.Range, Type:=wdFieldFormDropDown)

    dd_Guide.Name = "Guidance"
    dd_Guide.HelpText = "This item is Guidance."
    dd_Guide.ExitMacro = "DropDownChangeResult"
    With dd_Guide.DropDown.ListEntries
        .Add Name:="<Guidance>"
        .Add Name:="Applicable"
        .Add Name:="Delete"
        .Add Name:="Modify"
        .Add Name:="New Practice"
        .Add Name:="Id Ext Reference"
        .Add Name:="Not Applicable"
        .Add Name:="Add Comment"
        .Add Name:="DEFAULT Statement"
    End With
       
    With Selection
        .SelectCell
        .Copy
        .SelectColumn
        .Paste
        .MoveUp unit:=wdLine, Count:=1
        .Delete unit:=wdCharacter, Count:=1
        .TypeText Text:="Tailoring Type"
    End With
   
End Sub

Sub InsertEndMark()
'
' InsertEndMark Macro
' Macro recorded 9/9/2004 by
'
    With Selection
        .WholeStory
        .EndKey unit:=wdLine
        .TypeText ENDOFTEXTMARKER
        .FormFields.Add Range:=Selection.Range, Type:=wdFieldFormTextInput
        .PreviousField.Select
        .FormFields(1).Name = LASTFIELDMARKER
    End With
   
End Sub
Sub FindRequiredItems1()
Debug.Print "Now entering: FindRequiredItems1"
'
' FindRequiredItems Macro
'  by
'

    Selection.GoTo wdGoToLine, wdGoToFirst
   
    With Selection.Find
        .ClearFormatting
   
        Do While .Execute(FindText:="{SPP") = True
            With Selection
                With Selection.Find
                .Text = "{SPP"
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
                End With
            Selection.Find.Execute
            Selection.GoTo What:=wdGoToField, Which:=wdGoToPrevious, Count:=2
           
            If Selection.FormFields(1).Name = "Requirement" Then
                Exit Do
            End If
           
            Selection.Delete
            InsertReqDropDown
            Selection.MoveRight unit:=wdCell
            Selection.MoveRight unit:=wdCell
            End With
        Loop
   
    End With

End Sub

Sub FindRequiredItems2()
Debug.Print "Now entering: FindRequiredItems2"
'
' FindRequiredItems Macro
'  by
'
    Selection.GoTo wdGoToLine, wdGoToFirst
       
    With Selection.Find
        .ClearFormatting
   
        Do While .Execute(FindText:="(SPP") = True
        With Selection
            With Selection.Find
                .Text = "(SPP"
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
                .Execute
            End With
           
            Selection.GoTo What:=wdGoToField, Which:=wdGoToPrevious, Count:=2
           
            If Selection.FormFields(1).Name = "Requirement" Then
                Exit Do
            End If
           
            Selection.Delete
            InsertReqDropDown
            Selection.MoveRight unit:=wdCell
            Selection.MoveRight unit:=wdCell
           
        End With
        Loop
   
    End With

End Sub

Sub InsertReqDropDown()
Debug.Print "Now entering: InsertReqDropDown"
'
' InsertReqDropDown Macro
'  by
'
    Set dd_Req = Selection.FormFields.Add(Range:=Selection.Range, Type:=wdFieldFormDropDown)
   
    dd_Req.Name = "Requirement"
    dd_Req.HelpText = "This item is a Requirement."
    dd_Req.ExitMacro = "DropDownChangeResult"
   
    With dd_Req.DropDown.ListEntries
        .Add Name:="<Required>"
        .Add Name:="Comply"
        .Add Name:="Deviation"
        .Add Name:="Waiver"
        .Add Name:="Alternate Practice"
        .Add Name:="Add Comment"

    End With

End Sub

Sub DeleteIntroSectionFields()
'
' DeleteFields Macro
'  by
'
'Go to the top of the document
    Selection.WholeStory
    Selection.MoveLeft unit:=wdCharacter, Count:=1
   
    With Selection.Find
        .ClearFormatting
        .Text = "Entry Criteria"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute
    End With
   
    With Selection
        .MoveLeft unit:=wdCell
        .HomeKey unit:=wdStory, Extend:=wdExtend
        .Delete unit:=wdCharacter, Count:=1
        .TypeText Text:="Tailoring Type"
        .MoveRight unit:=wdCell
        .TypeText Text:="Rationale"
    End With
   
End Sub

Sub FindGuidanceUpdateStatement()
Debug.Print "Now entering: FindGuidanceUpdateStatement"
'
' EndOfDocBookmark Macro
'
' THIS MACRO WILL NOT WORK IF THERE ARE ANY HYPERLINKS IN THE TXT! (For now)

    'Go to the top of the document
    Selection.WholeStory
    Selection.MoveLeft unit:=wdCharacter, Count:=1
   
    'Go to the first field in the document
    Selection.GoTo What:=wdGoToField, Which:=wdGoToNext, Count:=1
   
    'Find each Guidance Field and update the Statement field,
    'until you get to the end of the document.
   
    Do Until Selection.FormFields(1).Name = LASTFIELDMARKER
        Selection.GoTo What:=wdGoToField, Which:=wdGoToNext, Count:=1
        If Selection.FormFields(1).Name = "Guidance" Then
            Selection.MoveRight unit:=wdCell
            Selection.MoveRight unit:=wdCell
            Selection.Copy
            CreateStatementField
        End If
    Loop
   
End Sub
Sub RemoveEndMarks()
'
' RemoveEndMarks Macro

'
    'Go to beginning of document
    Selection.WholeStory
    Selection.MoveLeft unit:=wdCharacter, Count:=1
   
    'Find the end text and replace with nothing (delete it)
    With Selection.Find
        .Text = ENDOFTEXTMARKER
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
    'Delete End form field
    Selection.EndKey unit:=wdStory
    Selection.MoveLeft
    Selection.Delete unit:=wdCharacter, Count:=1
    Selection.Style = "normal"
   
    'Return to top of document
    Selection.HomeKey unit:=wdStory
   
End Sub
'*******************************************
'* THIS IS THE END OF THE CODE THAT        *
'* CONVERTS DOCUMENTS INTO TAILORING TOOL. *
'*******************************************

'*******************************************
'* THIS IS THE CODE THAT THE USERS NEED    *
'* SO THAT THE TAILORING TOOL WILL WORK    *
'*******************************************
Sub DropDownChangeResult()

Dim CurrentDDValue As Integer
Dim UserChoice As String

CurrentDDValue = Selection.FormFields(1).DropDown.Value
UserChoice = Selection.FormFields(1).DropDown.ListEntries(CurrentDDValue).Name
 
' 9-13 removed all of the UnProtect/Protect from the Case statments and moved them
' before and after.  The "delete" case did not have unprotect/protect (but it does now)
    UnProtect
    Select Case UserChoice
        Case "Applicable"
            Call setBackgroundColor(wdColorBrightGreen)
        Case "Delete", "Modify"
            Call setBackgroundColor(wdColorYellow)
        Case "Waiver", "Deviation"
            Call setBackgroundColor(wdColorRed)
            'RemoveRequirementText
            StrikeoutRequirementText
        Case "Id Ext Reference"
            IdExtRef
            Call setBackgroundColor(wdColorBlue)
            MoveToRationaleCell
        Case "New Practice"
            NewPractice
            Call setBackgroundColor(wdColorBrightGreen)
            MoveToRationaleCell
        Case "Alternate Practice"
            Call setBackgroundColor(wdColorRed)
            AltPractice
            MoveToRationaleCell
        Case "Add Comment"
            NewComment
            Call setBackgroundColor(wdColorBlue)
            MoveToRationaleCell
        Case "Delete Row"
            DeleteRow
        Case "DEFAULT Statement"
            ResetDefText
        Case Else
            Call setBackgroundColor(wdColorAutomatic)
    End Select
    Protect
   
End Sub
Sub RemoveRequirementText()
    Selection.MoveRight unit:=wdCell
    Selection.MoveRight unit:=wdCell
    Selection.SelectCell
    Selection.Copy
    Selection.Cut
End Sub
Sub StrikeoutRequirementText()
    Selection.MoveRight unit:=wdCell
    Selection.MoveRight unit:=wdCell
    Selection.SelectCell
    With Selection.Font
        .StrikeThrough = True
        .Color = wdColorRed
    End With
End Sub
Sub ResetDefText()

    Dim Response, Style
    Dim Title As String, Msg As String

    Msg = "Are you sure you want to reset the Statement Text?"
   
    Title = "WARNING!!"
    Style = vbYesNo + vbExclamation + vbDefaultButton2
    Response = MsgBox(Msg, Style, Title)
    If Response = vbNo Then
    Exit Sub
    End If

   
    Dim DefaultText
    Selection.GoToNext wdGoToField
    Selection.GoToNext wdGoToField
    DefaultText = Selection.FormFields(1).TextInput.Default
    Selection.Delete
   
    Selection.FormFields.Add Range:=Selection.Range, Type:= _
        wdFieldFormTextInput
    Selection.PreviousField.Select
    With Selection.FormFields(1)
        .Name = "Statement"
        .EntryMacro = ""
        .ExitMacro = ""
        .Enabled = True
        .OwnHelp = True
        .HelpText = DefaultText
        .OwnStatus = False
        .StatusText = ""
        .TextInput.Width = 512
        .TextInput.EditType Type:=wdRegularText, Default:=DefaultText, Format:=""
    End With

End Sub
Sub MoveToRationaleCell()
    Selection.GoToNext wdGoToField
End Sub
Sub NewComment()
    InsertTableRow ("Comment")
End Sub
Sub IdExtRef()
    InsertTableRow ("ExtRef")
End Sub
Sub NewPractice()
    InsertTableRow ("NewPractice")
End Sub
Sub AltPractice()
    InsertTableRow ("AltPractice")
End Sub
Sub Protect()

    ActiveDocument.Protect Password:="", NoReset:=True, Type:=wdAllowOnlyFormFields

End Sub
Sub UnProtect()

    ActiveDocument.UnProtect Password:=""

End Sub
Sub InsertTableRow(RowType As String)

Debug.Print "Now Entering:  InsertTableRow"
'
' InsertTableRow Macro
'  by
'
'Id Req Type
Dim ReqType As String
ReqType = Selection.FormFields(1).Name
Debug.Print "ReqType= " & ReqType

    'Set current row dropdown to "default" <...> value:
    If RowType <> "AltPractice" Then
    Selection.FormFields(1).DropDown.Value = 1
    End If
   
    'insert row
    Selection.InsertRowsBelow
   
    'populate row with fields
    'create Tailoring Type Field
    CreateNewRowDropDown (RowType)

    'insert Rationale Field
    Selection.MoveRight unit:=wdCell, Count:=1
    CreateRationaleTextField
   
    'Create Statement Field
    Selection.MoveRight unit:=wdCell, Count:=1
    InsertNewStatementField
   
    Select Case RowType
        Case "Comment"
        Selection.SelectCell
        Selection.Style = "body"
        Selection.Font.Italic = True
       
        Case "ExtRef"
        Selection.SelectCell
        Selection.Style = "body"
        Selection.Font.Bold = True
    End Select
   
    'Return to Beginning of Row
    Selection.SelectRow
    Selection.MoveLeft unit:=wdCharacter, Count:=1
   
End Sub

Sub InsertNewStatementField()
    Selection.FormFields.Add Range:=Selection.Range, Type:=wdFieldFormTextInput
    Selection.PreviousField.Select
   
    With Selection.FormFields(1)
        .Name = "Statement"
        .EntryMacro = ""
        .ExitMacro = ""
        .Enabled = True
        .OwnHelp = False
        .HelpText = ""
        .OwnStatus = False
        .StatusText = ""
        .TextInput.Width = 512
    End With
End Sub

Sub CreateNewRowDropDown(NewRowType As String)

Set dd_NewRow = Selection.FormFields.Add( _
    Range:=Selection.Range, Type:=wdFieldFormDropDown)

    dd_NewRow.Name = NewRowType
    dd_NewRow.HelpText = "This item is Guidance."
    dd_NewRow.ExitMacro = "DropDownChangeResult"
   
    With dd_NewRow.DropDown.ListEntries
        Select Case NewRowType
            Case "NewPractice"
                .Add Name:="New Practice"
                .Add Name:="Delete Row"
            Case "AltPractice"
                .Add Name:="Alternate Practice"
                .Add Name:="Delete Row"
            Case "Comment"
                .Add Name:="Comment"
                .Add Name:="Delete Row"
            Case "ExtRef"
                .Add Name:="ID Ext Reference"
                .Add Name:="Delete Row"
        End Select
    End With
   
End Sub

Sub DeleteRow()
Debug.Print "Now entering: DeleteRow"

'This macro deletes a row that was previously added by the user
'The macro should first prompt the user with an "Are You Sure"
'Then remove the row if the user clicks ok, cancel will return the dd value
'to the first entry in the dd... which is the only other value besides "Delete Row"

Dim Msg, Style, Title, Response

    Msg = "Do you really want to delete the row?"    ' Define message.
    Style = vbYesNo + vbExclamation + vbDefaultButton2    ' Define buttons.
    Title = "WARNING: YOU ARE ABOUT TO DELETE A ROW!!"    ' Define title.
   
    Response = MsgBox(Msg, Style, Title)
   
    If Response = vbYes Then    ' User chose Yes.
        Selection.Rows.Delete
    Else
        Selection.FormFields(1).DropDown.Value = 1
    End If

End Sub

Sub setBackgroundColor(vColor As Variant)
    Selection.Cells.Shading.BackgroundPatternColor = vColor
End Sub

Sub GenDocs()
'
' GenDocs Macro
'  by
'
Dim CurrDocName, CurrDocPath
    CurrDocName = ActiveDocument.Name
    CurrDocPath = ActiveDocument.Path
    'Generate the "Clean" Version of the CurrentDoc

'But first, a warning:
Dim Response, Style
Dim Title As String, Msg As String

    Msg = "You are about to overwrite the Clean and Redline files for " & CurrDocName & ". If you would like to CANCEL and save the existing files please do so before proceeding. To PROCEED anyway, click the OK button."
   
    Title = "WARNING!!"
    Style = vbOKCancel + vbExclamation + vbDefaultButton2
    Response = MsgBox(Msg, Style, Title)
    If Response = vbCancel Then
    Exit Sub
    End If
   
    ' mdm - response is not checked
    ' ep  - response checking added
   
        ChangeFileOpenDirectory "..\" & TAILORINGFOLDER & "\"
        ActiveDocument.SaveAs FileName:="T_" & CurrDocName, FileFormat:= _
            wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
            True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
            False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
            SaveAsAOCELetter:=False
        With Selection
            .HomeKey unit:=wdLine
            .MoveUp unit:=wdLine, Count:=1
            .HomeKey unit:=wdStory
            .Rows.Delete
            .Columns.Delete
            .Columns.Delete
            .Rows.ConvertToText Separator:=wdSeparateByParagraphs, NestedTables:=True
            .Fields.Unlink
        End With
       
        ActiveDocument.Save
        ChangeFileOpenDirectory "..\" & REDLINEFOLDER & "\"
        ActiveDocument.SaveAs FileName:="R_" & CurrDocName, FileFormat:= _
            wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
            True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
            False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
            SaveAsAOCELetter:=False
       
        ''''  NEEDS CLEANING '''''
        ActiveDocument.Compare Name:="..\" & ENABLERfolder & "\1SPP-521_090304.doc"
           
        Selection.WholeStory
        Selection.HomeKey unit:=wdLine
        ActiveDocument.Save
       
End Sub
'*******************************************
'* THIS IS THE END OF THE CODE THAT        *
'*     THE USERS NEED                      *
'*******************************************
0
 
LVL 22

Expert Comment

by:Dreamboat
ID: 12058194
[quote]
    Selection.EndKey unit:=wdStory
    Selection.MoveLeft
[/quote]

You're trying to get to the top of the document?
That can be replaced with:
    Selection.HomeKey Unit:=wdStory


Sir, I think you should send me an email so that I can invite you into our Word VBA Training BETA course...
It's going slowly, but it IS going.
:)
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 12

Expert Comment

by:fulscher
ID: 12061688
epuglise.

the error sounds to me like you had some recursion going on (a function calling itself again and again). Do you have any startup code in this document?

Jan
0
 

Author Comment

by:epuglise
ID: 12065904
start up code?  Not sure what that is.  Unless Word created that on its own, I didn't create any.

Also, does anyone know if Autoformatting could be a performance issue with word?  If it is, is there a way to turn it off in my code?

thanks!!
0
 
LVL 22

Expert Comment

by:Dreamboat
ID: 12066105
OMG. Get RID of autoformatting. Heck yes, it bloats hell out of files, for one thing.

If you can send me your file, I will do my best to clean up your code. BUT that has to be outside the scope of this question, which should be answered separately.

You've got my addy.
I replied to your last email.
0
 
LVL 12

Accepted Solution

by:
fulscher earned 250 total points
ID: 12066112
epuglise

I just copied your code into a new word document, saved it and opened it. Works fine. No crash.

Please try the following: Create a new doc, copy all code from the old doc to the new doc, save and close. Maybe it's fixed then...

Otherwise, try to disable all add-ins: Goto Tools/Templates and Add-Ins, deselect all items in the list "Global templates and add-ins". Try again.

if it still doesn't work, it's probably your Normal.dot which is broken. It's normally saved in C:\Documents and Settings\<user name>\Application Data\Microsoft\Templates. Close Word and rename normal.dot to something else, like old-normal.dot. Word will create a new Normal.dot when you start it again.

If it still won't work, then you DO have startup code somewhere.

Jan
0
 

Author Comment

by:epuglise
ID: 12067910
I split the points because I did three things that solved this problem:

1.  turn off autoformatting (Dreamboat)
2.  Export code, reimport it (Dreamboat)
3.  "reset" my normal.dot

Folks thanks to all!!!

0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Suggested Solutions

Introduction This tutorial provides instructions on how to properly format your Word document using the inbuilt tools provided. The benefits of using these tools means your documents are more accessible and easily portable to other applications an…
I would like to show you some basics you can do with Mailings in MS Word. It´s quite handy feature you can use for creating envelopes, labels, personalized letters etc. First question could be what is this feature good for? Mailing can really he…
This video shows where to find the word count, how to display it, and what it breaks down to in Microsoft Word.
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now