The program comes to a halt. It browses and finds the folder, but thats all. I have the backend code:
Option Compare Database
Sub table_test()
Dim objApp As Word.Application
Dim str As String
str = "D:\gssProcedures\type2\STB-F-177 Teledyne Analyze Cal Proc.doc"
Set objApp = GetObject(, "Word.Application")
Dim objDoc As Document
Documents.Open str
Set objDoc = objApp.ActiveDocument
'Debug.Print objDoc.Sections(1).Headers(wdHeaderFooterFirstPage ).Range.Paragraphs.OutlineLevel
Dim objPars As Paragraphs
Dim objPar As Paragraph
Set objPars = objDoc.Sections(3).Headers(wdHeaderFooterPrimary). Range.Paragraphs
Dim k As Integer
k = 1
For Each objPar In objPars
Debug.Print k, Len(objPar.Range), mdlWordConversions.Clean_String(objPar.Range)
k = k + 1
Next
Dim objTabs As Tables
Dim objTab As Table
Set objTabs = objDoc.Tables
Dim i As Integer
i = 1
For Each objTab In objTabs
'Debug.Print "************************************************* ****"
'Debug.Print i, Len(objTab.Range), mdlWordConversions.Clean_String(objTab.Range)
i = i + 1
Next
'Debug.Print "NUMBER OF TABLES: " & objTabs.Count
'Debug.Print "################################################# #######"
Dim objPars1 As Paragraphs
Dim objPar1 As Paragraph
Set objPars1 = objDoc.Paragraphs
Dim strPar As String
Dim j As Integer
j = 0
For Each objPar1 In objPars1
strPar = mdlWordConversions.Clean_String(objPar1.Range)
'If j < 250 And strPar <> "FAIL" Then Debug.Print mdlDrawings.Pad_Zeroes(j, 3), objPar.OutlineLevel, strPar
j = j + 1
Next
Set objTabs = Nothing
objDoc.Close
Set objDoc = Nothing
Set objApp = Nothing
End Sub
Sub header_test()
Dim objApp As Word.Application
Dim str As String
str = "D:\Documents and Settings\gstiggin\Desktop\stb.doc"
Set objApp = GetObject(, "Word.Application")
Dim objDoc As Document
Documents.Open str
Set objDoc = objApp.ActiveDocument
'Debug.Print objDoc.Sections(1).Headers(wdHeaderFooterFirstPage ).Range.Paragraphs.OutlineLevel
Dim objPars As Paragraphs
Dim objPar As Paragraph
Set objPars = objDoc.Sections(1).Headers(wdHeaderFooterFirstPage ).Range.Paragraphs
Dim i As Integer
i = 1
For Each objPar In objPars
Debug.Print i, Len(objPar.Range), objPar.Range
i = i + 1
Next
Set objPars = Nothing
objDoc.Close
Set objDoc = Nothing
Set objApp = Nothing
End Sub
Sub dir_test()
Dim str As String
str = Dir("c:\gssProcedures\*.doc")
Debug.Print str
Do Until str = ""
str = Dir
Debug.Print str
Loop
End Sub
Sub ALL_TOGETHER_NOW()
Call dbs_test
MsgBox "Converted"
Call what_char
MsgBox "Cleaned"
DoCmd.OpenReport "Procedure", acViewPreview
MsgBox "Ta-da!"
End Sub
Sub what_char()
Dim dbs As Database
Dim rst As Object
Dim str As String
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("Procedure_Data")
'Set rst = dbs.OpenRecordset("SELECT * FROM Procedure_Data WHERE DOC_ID = 296")
'Debug.Print Right(rst!STEP, 1), Asc(Right(rst!STEP, 1))
'GoTo EXIT_MY_SUB
With rst
.MoveFirst
Do Until .EOF
Debug.Print !STEP_NUMBER
Try_Again:
If IsNull(!STEP) = False And (!STEP <> "") Then
If Asc(Right(!STEP, 1)) = 13 Or Asc(Right(!STEP, 1)) = 9 Or Asc(Right(!STEP, 1)) = 95 Or Asc(Right(!STEP, 1)) = 32 Then
Debug.Print " TRIM"
str = Left(!STEP, Len(!STEP) - 1)
.Edit
!STEP = str
.Update
GoTo Try_Again
End If
End If
.MoveNext
Loop
End With
'MsgBox Len(rst!STEP)
'Debug.Print "215", Mid(rst!STEP, 215, 1), Asc(Mid(rst!STEP, 215, 1))
'Debug.Print "216", Mid(rst!STEP, 216, 1), Asc(Mid(rst!STEP, 216, 1))
'Debug.Print "217", Mid(rst!STEP, 217, 1), Asc(Mid(rst!STEP, 217, 1))
'Debug.Print "218", Mid(rst!STEP, 218, 1), Asc(Mid(rst!STEP, 218, 1))
'Debug.Print "219", Mid(rst!STEP, 219, 1), Asc(Mid(rst!STEP, 219, 1))
'Debug.Print "220", Right(rst!STEP, 1), Asc(Right(rst!STEP, 1))
EXIT_MY_SUB:
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
End Sub
Sub dbs_test()
DoCmd.Hourglass True
Dim objApp As Word.Application
Dim dbs As Database
Dim rst As Object
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("Procedure_Data", dbOpenDynaset, dbSeeChanges)
Set objApp = GetObject(, "Word.Application")
Dim objDoc As Document
Set objDoc = objApp.ActiveDocument
Dim objPars As Paragraphs
Dim objPar As Paragraph
Set objPars = objDoc.Paragraphs
Dim i, j, k As Integer
i = 0
j = 0
k = 0
With rst
For Each objPar In objPars
If objPar.OutlineLevel <> 10 Then
Select Case objPar.OutlineLevel
Case 1
i = i + 1
j = 0
k = 0
.AddNew
!STEP_NUMBER = i & "." & mdlDrawings.Pad_Zeroes(CInt(j), 2) & "." & mdlDrawings.Pad_Zeroes(k, 2)
!LEVEL_01 = CLng(i)
!LEVEL_02 = CLng(j)
!LEVEL_03 = CLng(k)
!STEP = objPar.Range
!OUTLINE_LEVEL = objPar.OutlineLevel
.Update
Case 2
j = j + 1
k = 0
.AddNew
!STEP_NUMBER = i & "." & mdlDrawings.Pad_Zeroes(CInt(j), 2) & "." & mdlDrawings.Pad_Zeroes(k, 2)
!LEVEL_01 = CLng(i)
!LEVEL_02 = CLng(j)
!LEVEL_03 = CLng(k)
!STEP = objPar.Range
!OUTLINE_LEVEL = objPar.OutlineLevel
.Update
Case 3
k = k + 1
.AddNew
!STEP_NUMBER = i & "." & mdlDrawings.Pad_Zeroes(CInt(j), 2) & "." & mdlDrawings.Pad_Zeroes(k, 2)
!LEVEL_01 = CLng(i)
!LEVEL_02 = CLng(j)
!LEVEL_03 = CLng(k)
!STEP = objPar.Range
!OUTLINE_LEVEL = objPar.OutlineLevel
.Update
Case 4
.AddNew
!STEP_NUMBER = "ERROR4"
!LEVEL_01 = CLng(i)
!LEVEL_02 = CLng(j)
!LEVEL_03 = CLng(k)
!STEP = objPar.Range
!OUTLINE_LEVEL = objPar.OutlineLevel
.Update
Case 5
.AddNew
!STEP_NUMBER = "ERROR5"
!LEVEL_01 = CLng(i)
!LEVEL_02 = CLng(j)
!LEVEL_03 = CLng(k)
!STEP = objPar.Range
!OUTLINE_LEVEL = objPar.OutlineLevel
.Update
Case 6
.AddNew
!STEP_NUMBER = "ERROR6"
!LEVEL_01 = CLng(i)
!LEVEL_02 = CLng(j)
!LEVEL_03 = CLng(k)
!STEP = objPar.Range
!OUTLINE_LEVEL = objPar.OutlineLevel
.Update
Case 7
.AddNew
!STEP_NUMBER = "ERROR7"
!LEVEL_01 = CLng(i)
!LEVEL_02 = CLng(j)
!LEVEL_03 = CLng(k)
!STEP = objPar.Range
!OUTLINE_LEVEL = objPar.OutlineLevel
.Update
End Select
End If
Next
End With
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
DoCmd.Hourglass False
End Sub
Sub copy_test()
Dim files As FileSystemObject
Set files = CreateObject("Scripting.FileSystemObject")
files.MoveFile "D:\allProcedures\Type1\data_out.txt", "C:\data_out.txt"
Set files = Nothing
End Sub
Sub gss_test()
Dim objApp As Word.Application
DoCmd.Hourglass True
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim files As FileSystemObject
Dim file As TextStream
'Dim dbs As Database
'Dim rst As Recordset
'Set dbs = CurrentDb()
'Set rst = dbs.OpenRecordset("Procedure_Data")
Set files = CreateObject("Scripting.FileSystemObject")
Set file = files.OpenTextFile("c:\data_out.txt", ForAppending, False, TristateFalse)
Set objApp = GetObject(, "Word.Application")
Dim objDoc As Document
Set objDoc = objApp.ActiveDocument
Dim objPars As Paragraphs
Dim objPar As Paragraph
Set objPars = objDoc.Paragraphs
Dim i, j, k As Integer
i = 0
j = 0
k = 0
With rst
For Each objPar In objPars
'file.Write objPar.OutlineLevel & " " & objPar.Range & Chr(13)
'file.WriteLine i & " " & objPar.Range
If objPar.OutlineLevel <> 10 Then
Select Case objPar.OutlineLevel
'Case 1
' file.WriteLine mdlDrawings.Pad_Zeroes(i, 5) & " " & _
' mdlDrawings.Pad_Zeroes(objPar.OutlineLevel, 2) & " " & _
' objPar.Range
'
Case 1
i = i + 1
j = 0
k = 0
file.WriteBlankLines 2
file.WriteLine i & "." & mdlDrawings.Pad_Zeroes(CInt(j), 2) & "." & mdlDrawings.Pad_Zeroes(k, 2) & " " & _
Left(objPar.Range, 100)
Case 2
j = j + 1
k = 0
file.WriteLine " " & i & "." & mdlDrawings.Pad_Zeroes(CInt(j), 2) & "." & mdlDrawings.Pad_Zeroes(k, 2) & " " & _
Left(objPar.Range, 100)
Case 3
k = k + 1
file.WriteLine " " & " " & i & "." & mdlDrawings.Pad_Zeroes(CInt(j), 2) & "." & mdlDrawings.Pad_Zeroes(k, 2) & " " & _
Left(objPar.Range, 100)
Case 4
file.WriteLine " " & " " & " " & _
Left(objPar.Range, 100)
Case 5
file.WriteLine " " & " " & " " & " " & _
Left(objPar.Range, 100)
Case 6
file.WriteLine " " & " " & " " & " " & " " & " " & _
Left(objPar.Range, 100)
Case 7
file.WriteLine " " & " " & " " & " " & " " & " " & " " & " " & _
Left(objPar.Range, 100)
End Select
End If
Next
End With
file.Close
Set files = Nothing
'rst.Close
'Set rst = Nothing
'dbs.Close
'Set dbs = Nothing
DoCmd.Hourglass False
End Sub
Sub test()
Dim objApp As Word.Application
Set objApp = GetObject(, "Word.Application")
Dim objDoc As Document
Set objDoc = objApp.ActiveDocument
Dim objPars As Paragraphs
Dim objPar As Paragraph
Set objPars = objDoc.Paragraphs
For Each objPar In objPars
Debug.Print objPar.OutlineLevel, _
objPar.Range
Next
End Sub
Sub testlist()
Dim objApp As Word.Application
Set objApp = GetObject(, "Word.Application")
Dim objDoc As Document
Set objDoc = objApp.ActiveDocument
Dim mylists As Lists
Dim mylist As List
Set mylists = objDoc.Lists
For Each mylist In mylists
Debug.Print mylist.Range
Dim mylipars As ListParagraphs
Dim mylipar As Paragraph
Set mylipars = mylist.ListParagraphs
For Each mylipar In mylipars
Debug.Print mylipar.Style
Next
Next
End Sub
Sub testtabs()
Dim objApp As Word.Application
Set objApp = GetObject(, "Word.Application")
Dim objDoc As Document
Set objDoc = objApp.ActiveDocument
Dim mytabs As Tables
Dim mytab As Table
Set mytabs = objDoc.Tables
For Each mytab In mytabs
Debug.Print mytab.Range
Next
End Sub
|
