VBA EXCEL / WORD

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 :

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
What can be the problem that it doesn't work correctly?

Edited by Von Pookie ~ added code tags
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Forum statistics

Threads
1,216,225
Messages
6,129,602
Members
449,520
Latest member
TBFrieds

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top