Alright, I did what you said. I keep getting an error sying "subscript out of range." Basically I need
document list to export data to look like
excel
sample
I think what makes it more complicated is that some records don't have all the fields completed. I'm sorry for using your time. I really do appreciate any help. I'm not really a programmer at all. This is an assignment I have.
Sub Update()
Dim app As Object
Dim wbk As Object
Dim wsh As Object
Dim r As Long
Dim p As Long
Dim n As Long
Dim i As Long
Dim arr As Variant
Dim strLine As String
' Start Excel
On Error Resume Next
Set app = GetObject(Class:="Excel.Application")
If app Is Nothing Then
Set app = CreateObject(Class:="Excel.Application")
If app Is Nothing Then
MsgBox "Can't start Excel!", vbExclamation
Exit Sub
End If
End If
On Error GoTo ErrHandler
' Create workbook with one worksheet
app.ScreenUpdating = False
Set wbk = app.Workbooks.Add(Template:=-4167) ' xlWBATWorksheet
Set wsh = wbk.Worksheets(1)
r = 1
wsh.Cells(r, 1) = "Name"
wsh.Cells(r, 2) = "Address"
wsh.Cells(r, 3) = "City"
wsh.Cells(r, 4) = "State"
wsh.Cells(r, 5) = "ZIP"
wsh.Cells(r, 6) = "Country"
wsh.Cells(r, 7) = "Phone"
wsh.Cells(r, 8) = "Email"
wsh.Cells(r, 9) = "Position"
wsh.Cells(r, 10) = "1st EMAIL"
' Date
strLine = ActiveDocument.Paragraphs(1).Range.Text
p = InStr(strLine, vbTab)
strLine = Mid(strLine, p + 1, Len(strLine) - p)
wsh.Name = strLine
' Loop
n = ActiveDocument.Paragraphs.Count
For i = 2 To n
strLine = ActiveDocument.Paragraphs(i).Range.Text
strLine = Left(strLine, Len(strLine) - 1)
arr = Split(strLine, vbTab)
' Determine type
If arr(2) = "Database," Then
r = r + 1
wsh.Cells(r, 1) = arr(3)
ElseIf arr(1) = "Offices located in San Diego CA" Then
wsh.Cells(r, 2) = arr(2)
ElseIf arr(1) = "COUNT" And UBound(arr) >= 3 Then
wsh.Cells(r, 3) = arr(3)
ElseIf arr(1) = "ADDRESS" Then
wsh.Cells(r, 4) = arr(2)
wsh.Cells(r, 5) = arr(4)
Else
' Footer - ignore
End If
Next i
ExitHandler:
If Not app Is Nothing Then
wsh.Range("A1:J1").EntireColumn.AutoFit
app.ScreenUpdating = True
app.Visible = True
End If
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler
End Sub
