Jan Liekens
New Member
- Joined
- Feb 20, 2006
- Messages
- 1
I have a in Excel a list of Word files. I want to open them one by one. I do ik like this :
The macro opens Word en close them again but doesn't start in Word the macro to copy an paste in Excel.
In Word is the macro:
What can be the problem that it doesn't work correctly?
Edited by Von Pookie ~ added code tags
Code:
Option Explicit
Dim WorkbookName
Sub OpenWordDoc()
On Error GoTo ErrorHandler
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim teller As Integer
Dim bestandsnaam As String
Sheets("LijstBestand").Select
Range("B3").Select
teller = 0
For teller = 1 To [kz_teller]
ActiveCell.Offset(1, 0).Select
bestandsnaam = ActiveCell
Set wrdApp = CreateObject("Word.Application")
' wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open(bestandsnaam)
With wrdApp
.Visible = True
.Application.Run MacroName:="Project.NewMacros.mcrKopieRapGeg"
End With
wrdApp.Quit
' xlWB.Close False 'close the workbook without saving
' xlApp.Quit 'close the Excel application
Set wrdApp = Nothing
Set wrdDoc = Nothing
Next teller
Exit Sub
ErrorHandler:
MsgBox " Fout : " & Err & " opgetreden tijdens uitvoering programma " & Chr(13) & _
" Omschrijving : " & Error, vbCritical
End Sub
Function WorkbookOpen(WorkbookName As String) As Boolean
'Returns TRUE if the workbook is open
WorkbookOpen = False
On Error GoTo WorkbookNotOpen
If Len(Application.Workbooks(WorkbookName).Name) > 0 Then
WorkbookOpen = True
Exit Function
End If
WorkbookNotOpen
End Function
The macro opens Word en close them again but doesn't start in Word the macro to copy an paste in Excel.
In Word is the macro:
Code:
Sub mcrKopieRapGeg()
'
' mcrKopieRapGeg Macro
' Macro recorded 23/12/2005 by Liekens Jan U34308/A0KB291
'
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oSheet As Excel.Worksheet
Dim oRng As Excel.Range
Dim ExcelWasNotRunning As Boolean
Dim WorkbookToWorkOn As String
Selection.GoTo What:=wdGoToBookmark, Name:="bkmIdentiteitsgegevens"
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Uitvoeringstermijn"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Copy
'specify the workbook to work on
WorkbookToWorkOn = "O:\groep\Zaakschade\Inspecties brand\Brand questionnaire builder\Brandprev.xls"
'If Excel is running, get a handle on it; otherwise start a new instance of Excel
On Error Resume Next
Set oXL = GetObject(, "Excel.Application")
If Err Then
ExcelWasNotRunning = True
Set oXL = New Excel.Application
End If
On Error GoTo Err_Handler
'If you want Excel to be visible, you could add the line: oXL.Visible = True here; but your code will run faster if you don't make it visible
oXL.Visible = True
'Open the workbook
Set oWB = oXL.Workbooks.Open(FileName:=WorkbookToWorkOn)
'Process each of the spreadsheets in the workbook
For Each oSheet In oXL.ActiveWorkbook.Worksheets
'put guts of your code here
'get next sheet
With oXL
' .Visible = True
.Application.Run "Brandprev.xls!mcrPlakkenGegevens"
End With
Next oSheet
If ExcelWasNotRunning Then
oXL.Quit
End If
'Make sure you release object references.
Set oRng = Nothing
Set oSheet = Nothing
Set oWB = Nothing
Set oXL = Nothing
'quit
Exit Sub
Err_Handler:
Application.DisplayAlerts = wdAlertsNone
MsgBox WorkbookToWorkOn & " : veroorzaakt een probleem. " & Err.Description, vbCritical, _
"Error: " & Err.Number
If ExcelWasNotRunning Then
oXL.Quit
End If
End Sub
Edited by Von Pookie ~ added code tags