J
joseph.choi13
I'm on my last straw:
First of all thanks to all those who have helped with this problem.
However, I'm still having problems because I'm 2 months into VBA and my
code is just a cut and paste from google findings. I'm just going to
paste the entire code. Here are my problems:
1). I get a "the remote server machine does not exist" error sometimes
when I run this code (usually if its the first time running the macro).
2). Sometimes I don't get the correct Word document I want to run in
the macro; I get the previous document (this usually happens when
there's an error previously). I would have to go task manager and kill
WINWORD.exe then run the macro again.
**NOTE: I did update my reference to Word Object Library.
Can someone help me fix my code so I don't have to manually go into the
task manager?
Sub LetsGo()
Dim wrdApp As New Word.Application
Dim wrdDoc As Word.Document
Dim tString As String, tRange As Word.Range
Dim myNBR As Variant
Dim appwd As Object
On Error GoTo notloaded
Set appwd = GetObject("Word.Application")
notloaded:
If Err.Number = 429 Then
Set appwd = CreateObject("Word.Application")
End If
'appwd.Visible = True
On Error GoTo 0
With appwd
myNBR = Application.GetOpenFilename(FileFilter:="Word Files (*.doc),
*.doc", Title:="Please select a file")
End With
If myNBR = False Then
' They pressed Cancel
MsgBox "Stopping because you did not select a file"
Exit Sub
End If
Workbooks("4xMatrix-Grouping and Coding_v4").Activate
On Error Resume Next
Application.DisplayAlerts = False
Sheets("NBR Xfer").Delete
Application.DisplayAlerts = True
With Worksheets.Add
On Error Resume Next
..Name = "NBR Xfer"
On Error GoTo 0
End With
With Range("A1")
..Formula = "Word Document Contents:"
..Font.Bold = True
..Font.Size = 14
..Offset(1, 0).Select
End With
r = 3 ' startrow for the copied text from the Word document
Set wrdApp = CreateObject("Word.Application")
'wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open(myNBR)
With wrdDoc
For i = 1 To 10
Set oTableRge = wrdApp.Tables(i).Range
For Each oCell In oTableRge.Cells
If InStr(1, Left((oCell.Range.Text), Len(oCell.Range.Text) - 1), "233
CTB Response is one of:", vbTextCompare) > 0 Then
j = i
End If
Next
Next i
Set oTableRge = ActiveDocument.Tables(j).Range
For Each oCells In oTableRge.Cells
tString = Left((oCells.Range.Text), Len(oCells.Range.Text) - 1)
If tString = Chr(160) & Chr(13) Then
GoTo Jump
Else
ActiveSheet.Range("A" & r).Formula = tString
r = r + 1
End If
Jump:
Next
..Close ' close the document
End With
wrdApp.Quit ' close the Word application
Set wrdDoc = Nothing
Set wrdApp = Nothing
ActiveWorkbook.Saved = True
Call ImportTranslation
End Sub
First of all thanks to all those who have helped with this problem.
However, I'm still having problems because I'm 2 months into VBA and my
code is just a cut and paste from google findings. I'm just going to
paste the entire code. Here are my problems:
1). I get a "the remote server machine does not exist" error sometimes
when I run this code (usually if its the first time running the macro).
2). Sometimes I don't get the correct Word document I want to run in
the macro; I get the previous document (this usually happens when
there's an error previously). I would have to go task manager and kill
WINWORD.exe then run the macro again.
**NOTE: I did update my reference to Word Object Library.
Can someone help me fix my code so I don't have to manually go into the
task manager?
Sub LetsGo()
Dim wrdApp As New Word.Application
Dim wrdDoc As Word.Document
Dim tString As String, tRange As Word.Range
Dim myNBR As Variant
Dim appwd As Object
On Error GoTo notloaded
Set appwd = GetObject("Word.Application")
notloaded:
If Err.Number = 429 Then
Set appwd = CreateObject("Word.Application")
End If
'appwd.Visible = True
On Error GoTo 0
With appwd
myNBR = Application.GetOpenFilename(FileFilter:="Word Files (*.doc),
*.doc", Title:="Please select a file")
End With
If myNBR = False Then
' They pressed Cancel
MsgBox "Stopping because you did not select a file"
Exit Sub
End If
Workbooks("4xMatrix-Grouping and Coding_v4").Activate
On Error Resume Next
Application.DisplayAlerts = False
Sheets("NBR Xfer").Delete
Application.DisplayAlerts = True
With Worksheets.Add
On Error Resume Next
..Name = "NBR Xfer"
On Error GoTo 0
End With
With Range("A1")
..Formula = "Word Document Contents:"
..Font.Bold = True
..Font.Size = 14
..Offset(1, 0).Select
End With
r = 3 ' startrow for the copied text from the Word document
Set wrdApp = CreateObject("Word.Application")
'wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open(myNBR)
With wrdDoc
For i = 1 To 10
Set oTableRge = wrdApp.Tables(i).Range
For Each oCell In oTableRge.Cells
If InStr(1, Left((oCell.Range.Text), Len(oCell.Range.Text) - 1), "233
CTB Response is one of:", vbTextCompare) > 0 Then
j = i
End If
Next
Next i
Set oTableRge = ActiveDocument.Tables(j).Range
For Each oCells In oTableRge.Cells
tString = Left((oCells.Range.Text), Len(oCells.Range.Text) - 1)
If tString = Chr(160) & Chr(13) Then
GoTo Jump
Else
ActiveSheet.Range("A" & r).Formula = tString
r = r + 1
End If
Jump:
Next
..Close ' close the document
End With
wrdApp.Quit ' close the Word application
Set wrdDoc = Nothing
Set wrdApp = Nothing
ActiveWorkbook.Saved = True
Call ImportTranslation
End Sub