2014-12-11 2 views
-1

Я пытаюсь получить информацию из таблицы в Word и вытащить ее в Excel, так как число таблиц является переменным, и у меня нет другого способа ссылки на таблицу, которую я хотел найдите таблицу непосредственно после текста перед документом. Я использовал метод .find раньше, но по некоторым причинам я не могу заставить его работать на этот раз и от всего, что я читал и использовал раньше, это должно работать:. Не работает в Word из Excel vba

Sub Process_NIM() 
    Dim WordPullFile As Object 
    Dim PullFolder As String 
    Dim PullDate As Date 
    Dim AppWord As Word.Application 
    Dim wd As Word.Document 
    Dim Table1 As Word.Table 
    Dim wb As Workbook 
    Dim ws1, ws2 As Worksheet 
    Dim Text1 As Word.Range 

    PullDate = DateAdd("d", 1, Now()) 
    PullFolder = "M:\Production Case Files\" & Format(PullDate, "YYYY") & _ 
     " Production Case Files\" & UCase(Format(PullDate, "MMM")) & _ 
     "\" & UCase(Format(PullDate, "MMM DD")) & "\" 
    On Error GoTo OpenFileError 
    Set WordPullFile = Application.FileDialog(msoFileDialogOpen) 
    With WordPullFile 
     .AllowMultiSelect = False 
     .Filters.clear 
     .Filters.Add "DOC Files (*.doc)", "*.doc" 
     .InitialFileName = PullFolder 
     .Show 
    End With 
    On Error GoTo 0 
    If WordPullFile.SelectedItems.Count > 0 Then 
     PullFolder = WordPullFile.SelectedItems(1) 
    End If 

    Set AppWord = CreateObject("Word.Application") 
    Set wd = AppWord.Documents.Open(PullFolder) 
    wd.Application.Visible = True 

    Set wb = ThisWorkbook 
    Set ws1 = wb.Worksheets(1) 
    Set ws2 = wb.Worksheets(2) 

    If Text1.wd.Selection.Find.Execute(findtext:="Generator Outages for Today - Greater than 25MW") = True Then 
     'do stuff 
    End If 

OpenFileError: 
    MsgBox ("There was an error opening the word file. Try closing any other instances of word and re-run.") 
    Exit Sub 

End Sub 

Я использую это от слова в настоящее время, но я не могу заставить его работать с Excel:

If Text1.Find.Execute(findtext:="RC South Regional Review for") Then 
    Text1.InsertAfter (" " & Format(FileDate, "MMMM DD, YYYY")) 
End If 
+0

Text1.wd.Selection.Find Изменение в wd.Range.Find – Sorceri

+0

Это работает в поиске текста, но он не делает то, что код, который я призван, то есть присвоить место нахождения найден текст Text1. –

ответ

0

хорошие новости, текст, который вы говорите, что вы используете в слово, что не работает в Excel, на самом деле работает. Проблема связана со значением, которое вы пытаетесь ввести, я использовал ваш код, и некоторое время я был в тупике, потому что он, похоже, не работал, но когда я заменил какой-то простой текст вместо вашей даты, он работал нормально, я нахожу работу. Оказывается, это просто не разрешало Filedate в качестве даты и поэтому ничего не вставляло. Вот версия вашего кода, измененная для работы на моем ПК, которая вставляет дату после найденной строки, вы хотели добавить Pulldate вместо Filedate в качестве переменной, которую можно добавить?

Sub Process_NIM() 
    Dim WordPullFile As Object 
    Dim PullFolder As String 
    Dim PullDate As Date 
    Dim AppWord As Word.Application 
    Dim wd As Word.Document 
    Dim Table1 As Word.Table 
    Dim wb As Workbook 
    Dim ws1, ws2 As Worksheet 
    Dim Text1 As Word.Range 

    PullDate = DateAdd("d", 1, Now()) 
    PullFolder = "D:\Users\Mark\Documents\" 
    On Error GoTo OpenFileError 
    Set WordPullFile = Application.FileDialog(msoFileDialogOpen) 
    With WordPullFile 
     .AllowMultiSelect = False 
     .Filters.Clear 
     .Filters.Add "DOC Files (*.doc)", "*.doc" 
     .InitialFileName = PullFolder 
     .Show 
    End With 
    On Error GoTo 0 
    If WordPullFile.SelectedItems.Count > 0 Then 
     PullFolder = WordPullFile.SelectedItems(1) 
    End If 

    Set AppWord = CreateObject("Word.Application") 
    Set wd = AppWord.Documents.Open(PullFolder) 
    wd.Application.Visible = True 

    Set wb = ThisWorkbook 
    Set ws1 = wb.Worksheets(1) 
    Set ws2 = wb.Worksheets(2) 

    Set Text1 = wd.Range 
If Text1.Find.Execute(findtext:="RC South Regional Review for") Then 
    Text1.InsertAfter (" " & Format(Date, "MMMM DD, YYYY")) 
Else 
    MsgBox "could not find text" 
End If 
wd.Save 
wd.Close 
AppWord.Quit 
Set AppWord = Nothing 

Exit Sub 
OpenFileError: 
    MsgBox ("There was an error opening the word file. Try closing any other instances of word and re-run.") 
    Exit Sub 

End Sub 
+0

Второй бит кода из другого файла, но я использовал это как отправную точку для этого файла. Я не знаю, как я раньше не пытался установить Text1 = wd.range, но, по-видимому, исправил его. –