CODE
Private Sub FillDefects_Click()
Dim oDoc As Word.Document
Dim oWord As Word.Application
Dim intIndex As Integer
Dim myrange As Word.Range
Dim desc As String
Dim disco As String
Dim loca As String
Dim meetid As String
Dim path As String
meetid = " "
loca = " "
disco = " "
desc = " "
intIndex = 1
path = InputBox("Please enter document path and file name (must end in .doc; do not add a final \)", "Document")
If Len(path) < 4 Then
MsgBox "Not a Microsoft Word document!"
Exit Sub
End If
If Mid(path, Len(path) - 3, 4) = ".doc" Then
Set oWord = New Word.Application
Set oDoc = GetObject(path)
oWord.Documents.Add (path)
MsgBox "!"
Else
MsgBox "Not a Microsoft Word document!"
Exit Sub
End If
meetid = Mid(Me.lblMeetingID.Caption, 13, Len(Me.lblMeetingID.Caption))
Do While intIndex <= oDoc.Comments.Count
desc = oDoc.Comments(intIndex).Range
disco = oDoc.Comments(intIndex).Author
'Set myrange = oDoc.Comments(intIndex).Scope
oDoc.Comments(intIndex).Scope.Select
loca = Selection.Information(wdActiveEndAdjustedPageNumber) _
& ":" & Selection.Information(wdFirstCharacterLineNumber)
DoCmd.RunSQL "INSERT INTO [Defects] ([Meeting ID],[Location], [Discovered By], [Description]) VALUES ('" & meetid & "' , '" & Replace(loca, "'", "''") & "' , '" & Replace(disco, "'", "''") & "' , '" & Replace(desc, "'", "''") & "')"
intIndex = intIndex + 1
Loop
Me.Defects_subform1.Form.RecordSource = "SELECT [Description],[Location],[Category],[Discovered By]," & _
"[Global],[New],[Done],[Resolution],[Meeting ID],[Severity]," & _
"[Defect Injected],[Defect Detected]" & _
" FROM [Defects] WHERE [Meeting ID] = '" & meetid & "'"
oDoc.Close
oWord.Quit
End Sub
Dim oDoc As Word.Document
Dim oWord As Word.Application
Dim intIndex As Integer
Dim myrange As Word.Range
Dim desc As String
Dim disco As String
Dim loca As String
Dim meetid As String
Dim path As String
meetid = " "
loca = " "
disco = " "
desc = " "
intIndex = 1
path = InputBox("Please enter document path and file name (must end in .doc; do not add a final \)", "Document")
If Len(path) < 4 Then
MsgBox "Not a Microsoft Word document!"
Exit Sub
End If
If Mid(path, Len(path) - 3, 4) = ".doc" Then
Set oWord = New Word.Application
Set oDoc = GetObject(path)
oWord.Documents.Add (path)
MsgBox "!"
Else
MsgBox "Not a Microsoft Word document!"
Exit Sub
End If
meetid = Mid(Me.lblMeetingID.Caption, 13, Len(Me.lblMeetingID.Caption))
Do While intIndex <= oDoc.Comments.Count
desc = oDoc.Comments(intIndex).Range
disco = oDoc.Comments(intIndex).Author
'Set myrange = oDoc.Comments(intIndex).Scope
oDoc.Comments(intIndex).Scope.Select
loca = Selection.Information(wdActiveEndAdjustedPageNumber) _
& ":" & Selection.Information(wdFirstCharacterLineNumber)
DoCmd.RunSQL "INSERT INTO [Defects] ([Meeting ID],[Location], [Discovered By], [Description]) VALUES ('" & meetid & "' , '" & Replace(loca, "'", "''") & "' , '" & Replace(disco, "'", "''") & "' , '" & Replace(desc, "'", "''") & "')"
intIndex = intIndex + 1
Loop
Me.Defects_subform1.Form.RecordSource = "SELECT [Description],[Location],[Category],[Discovered By]," & _
"[Global],[New],[Done],[Resolution],[Meeting ID],[Severity]," & _
"[Defect Injected],[Defect Detected]" & _
" FROM [Defects] WHERE [Meeting ID] = '" & meetid & "'"
oDoc.Close
oWord.Quit
End Sub
Thanks