W
Winokemon
I've been using the "attached" macro successfully, but it recently gave
me a "runtime error 6--Overflow" error.
Debug took me to the line: "startPos = Selection.End"
The macro is designed to copy selected text to a table in another file,
bookmark that text at the end of that file, and then insert it back
into the source document by reference using an IncludeText field.
At the 38th time I ran it, it pasted the text into the last row of the
table as usual, but it didn't paste at the end of the file, create the
bookmark, etc--and gave me the "Overflow" error instead.
I'm hoping someone can help me fix this as I'm in over my head.
Cheers (Thanks),
Byron
------VBA Code-----------------------------
Sub makeBookmarks()
Dim nameMark
Dim tail
Dim myPath As String
Dim frFile As Document
Dim scFile As Document
Dim startPos As Integer
Dim endPos As Integer
'change the file path and root name for the bookmarks here.
nameMark = "MyProject"
myPath = "C:\Documents and Settings\me\My
Documents\Curren~1\Product\v4.5 source info\ProductV45difs.doc"
Selection.Copy
Set frFile = ActiveDocument
' Dim fd As FileDialog
' Set fd = Application.FileDialog(msoFileDialogFilePicker)
' Dim vrtSelectedItem As Variant
' With fd
' .AllowMultiSelect = False
' If .Show = -1 Then
' For Each vrtSelectedItem In .SelectedItems
' myPath = vrtSelectedItem
' Next vrtSelectedItem
' Else
' End If
' End With
' Set fd = Nothing
Set scFile = Documents.Open(myPath)
scFile.Activate
'insert a row at end of the table if the table already there.
otherwise create a new table
If scFile.Tables.Count = 0 Then
scFile.Tables.Add Range:=Selection.Range, NumRows:=1,
Numcolumns:=2
tail = 1
Else
scFile.Tables(1).Rows.Add
tail = scFile.Tables(1).Rows.Count
End If
With scFile.Tables(1).Rows(tail)
nameMark = nameMark & tail
.Cells(1).Range.Text = nameMark
.Cells(2).Range.Select
End With
'paste the text and move the cursor to the end of the file in order
to insert the bookmarks
With Selection
.Paste
.WholeStory
.EndKey
startPos = Selection.End
.Paste
endPos = Selection.End
End With
With ActiveDocument.Bookmarks
.Add Range:=ActiveDocument.Range(startPos, endPos),
Name:=nameMark
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
Selection.EndKey
Selection.InsertAfter Chr(13)
scFile.Save
'add the include field in the original file
Dim tempString
tempString = "INCLUDETEXT " & Chr(34) & Replace(myPath, "\", "\\")
& Chr(34) & " " & nameMark
frFile.Activate
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, Text:=tempString, PreserveFormatting:=False
ActiveWindow.View.ShowFieldCodes = Not
ActiveWindow.View.ShowFieldCodes
End Sub
me a "runtime error 6--Overflow" error.
Debug took me to the line: "startPos = Selection.End"
The macro is designed to copy selected text to a table in another file,
bookmark that text at the end of that file, and then insert it back
into the source document by reference using an IncludeText field.
At the 38th time I ran it, it pasted the text into the last row of the
table as usual, but it didn't paste at the end of the file, create the
bookmark, etc--and gave me the "Overflow" error instead.
I'm hoping someone can help me fix this as I'm in over my head.
Cheers (Thanks),
Byron
------VBA Code-----------------------------
Sub makeBookmarks()
Dim nameMark
Dim tail
Dim myPath As String
Dim frFile As Document
Dim scFile As Document
Dim startPos As Integer
Dim endPos As Integer
'change the file path and root name for the bookmarks here.
nameMark = "MyProject"
myPath = "C:\Documents and Settings\me\My
Documents\Curren~1\Product\v4.5 source info\ProductV45difs.doc"
Selection.Copy
Set frFile = ActiveDocument
' Dim fd As FileDialog
' Set fd = Application.FileDialog(msoFileDialogFilePicker)
' Dim vrtSelectedItem As Variant
' With fd
' .AllowMultiSelect = False
' If .Show = -1 Then
' For Each vrtSelectedItem In .SelectedItems
' myPath = vrtSelectedItem
' Next vrtSelectedItem
' Else
' End If
' End With
' Set fd = Nothing
Set scFile = Documents.Open(myPath)
scFile.Activate
'insert a row at end of the table if the table already there.
otherwise create a new table
If scFile.Tables.Count = 0 Then
scFile.Tables.Add Range:=Selection.Range, NumRows:=1,
Numcolumns:=2
tail = 1
Else
scFile.Tables(1).Rows.Add
tail = scFile.Tables(1).Rows.Count
End If
With scFile.Tables(1).Rows(tail)
nameMark = nameMark & tail
.Cells(1).Range.Text = nameMark
.Cells(2).Range.Select
End With
'paste the text and move the cursor to the end of the file in order
to insert the bookmarks
With Selection
.Paste
.WholeStory
.EndKey
startPos = Selection.End
.Paste
endPos = Selection.End
End With
With ActiveDocument.Bookmarks
.Add Range:=ActiveDocument.Range(startPos, endPos),
Name:=nameMark
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
Selection.EndKey
Selection.InsertAfter Chr(13)
scFile.Save
'add the include field in the original file
Dim tempString
tempString = "INCLUDETEXT " & Chr(34) & Replace(myPath, "\", "\\")
& Chr(34) & " " & nameMark
frFile.Activate
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, Text:=tempString, PreserveFormatting:=False
ActiveWindow.View.ShowFieldCodes = Not
ActiveWindow.View.ShowFieldCodes
End Sub