![]() |
|
#1
|
|||
|
|||
![]()
hello dears
whin i run this macro i got Run-time error '5624. code ---- Code:
Sub demo() Application.ScreenUpdating = True Dim strFolder As String, strFile As String, wdDoc As Document Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String Dim bStrt As Boolean, iDataRow As Long, bFound As Boolean Dim xlFList As String, xlRList As String, i As Long, Rslt ' modify code to make .xls as relative path Dim My_Path As String My_Path = Applicatio StrWkBkNm = My_path & "\table.xls" StrWkSht = "list" If Dir(StrWkBkNm) = "" Then MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation Exit Sub End If 'Get the folder to process strFolder = GetFolder If strFolder = "" Then Exit Sub strFile = Dir(strFolder & "\*.doc", vbNormal) ' Test whether Excel is already running. On Error Resume Next bStrt = False ' Flag to record if we start Excel, so we can close it later. Set xlApp = GetObject(, "Excel.Application") 'Start Excel if it isn't running If xlApp Is Nothing Then Set xlApp = CreateObject("Excel.Application") If xlApp Is Nothing Then MsgBox "Can't start Excel.", vbExclamation Exit Sub End If ' Record that we've started Excel. bStrt = True End If On Error GoTo 0 'Check if the workbook is open. bFound = False With xlApp 'Hide our Excel session If bStrt = True Then .Visible = False For Each xlWkBk In .Workbooks If xlWkBk.FullName = StrWkBkNm Then ' It's open Set xlWkBk = xlWkBk bFound = True Exit For End If Next ' If not open by the current user. If bFound = False Then ' Check if another user has it open. If IsFileLocked(StrWkBkNm) = True Then ' Report and exit if true MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use" If bStrt = True Then .Quit Exit Sub End If ' The file is available, so open it. Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm) If xlWkBk Is Nothing Then MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation If bStrt = True Then .Quit Exit Sub End If End If ' Process the workbook. With xlWkBk.Worksheets(StrWkSht) ' Find the last-used row in column A. ' Add 1 to get the next row for data-entry. iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp ' Output the captured data. For i = 1 To iDataRow ' Skip over empty fields to preserve the underlying cell contents. If Trim(.Range("A" & i)) <> vbNullString Then xlFList = xlFList & "|" & Trim(.Range("A" & i)) xlRList = xlRList & "|" & Trim(.Range("B" & i)) End If Next End With If bFound = False Then xlWkBk.Close False If bStrt = True Then .Quit End With ' Release Excel object memory Set xlWkBk = Nothing: Set xlApp = Nothing 'Process each document in the folder While strFile <> "" Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False) 'Process each word from the F/R List For i = 1 To UBound(Split(xlFList, "|")) With wdDoc.Range With .Find .ClearFormatting .Replacement.ClearFormatting ' .MatchWholeWord = True .MatchCase = True .Wrap = wdFindStop .Font.Name = "tahoma" .Text = Split(xlFList, "|")(i) .Replacement.Font.Name = "black br" .Replacement.Text = Split(xlRList, "|")(i) ' debugger show this line .Execute Replace:=wdReplaceAll End With End With Next 'Close the document wdDoc.Close SaveChanges:=True MsgBox "document saved" 'Get the next document strFile = Dir() Wend Application.ScreenUpdating = True End Sub Function GetFolder() As String Dim oFolder As Object GetFolder = "" Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0) If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path Set oFolder = Nothing End Function Function IsFileLocked(strFileName As String) As Boolean On Error Resume Next Open strFileName For Binary Access Read Write Lock Read Write As #1 Close #1 IsFileLocked = Err.Number Err.Clear End Function Last edited by macropod; 03-12-2017 at 06:12 AM. Reason: Added code tags |
![]() |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Macro to replace digits with letters | Bananabean | Word VBA | 6 | 09-14-2013 09:28 PM |
![]() |
pstein | Word | 1 | 04-30-2013 05:58 AM |
![]() |
winningson | Word | 3 | 01-19-2013 05:38 AM |
![]() |
herbhh | Word | 10 | 05-23-2011 08:29 AM |
How do I import text columns with specified spacing between words w/o losing format? | Fucius | Word | 0 | 08-09-2010 06:23 PM |