PDA

View Full Version : run-time error "4198"



alliewang
11-09-2017, 11:38 PM
I'm encountering error from VBA which runs fine before and don't know where was revised and triggered error 4198.
The debug function indicated error from the bottom sixth row: appWD.ActiveDocument.SaveAs2 (TWD_SLoc & "\" & ThisWorkbook.Sheets("TWD").Range("D" & i + 1) & ".docx"), which seems to be a normal saving function.
This macro is meant to merge excel data into word template to create individual word report. All word files were successfully created and saved using this macro, however stuck just before ended. The true problem seems to be that vba kept on running after all data were run through.
Hoping for some great opinions! I'm desperate...


[/CODE]
Sub Report_TWD()

Dim TWD_MLoc As String, TWD_DLoc As String, TWD_SLoc As String


TWD_MLoc = ThisWorkbook.Sheets("執行").Range("B5").Value
TWD_DLoc = ThisWorkbook.Sheets("執行").Range("C5").Value
TWD_SLoc = ThisWorkbook.Sheets("執行").Range("D5").Value


Dim appWD As Word.Application
Set appWD = CreateObject("Word.Application")
appWD.Visible = True
Dim TWDWD As Word.Document
Set TWDWD = appWD.Documents.Open(TWD_MLoc)
TWDWD.Activate
TWDWD.MailMerge.OpenDataSource Name:=TWD_DLoc, SQLStatement:="SELECT * FROM `TWD$`"


Dim x As Long
Dim i As Long
Dim v As Long, w As Long
Dim stMsg As String


TWDWD.Activate
With TWDWD.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.ActiveRecord = wdLastRecord
x = .ActiveRecord
.ActiveRecord = wdFirstRecord
End With


For i = 1 To x
.DataSource.FirstRecord = i
.DataSource.LastRecord = i
.Execute
appWD.ActiveDocument.SaveAs2 (TWD_SLoc & "\" & ThisWorkbook.Sheets("TWD").Range("D" & i + 1) & ".docx")
appWD.ActiveDocument.Close wdDoNotSaveChanges
Next i
End With
TWDWD.Close wdDoNotSaveChanges
End Sub
[/CODE]

snb
11-10-2017, 01:37 AM
I think the brackets are the culprit, or an illegal character in range D1. D2, D3.
Since the path is written in D5 this code must error out in the 5th loop.

What is the result of ?

Msgbox TWD_SLoc & "\" & ThisWorkbook.Sheets("TWD").Range("D" & i + 1) & ".docx"
appWD.ActiveDocument.SaveAs2 TWD_SLoc & "\" & ThisWorkbook.Sheets("TWD").Range("D" & i + 1) & ".docx"


You can reduce the code:


Sub M_snb()
sn = ThisWorkbook.Sheets("執行").cells(1).currentregion

with getobject(sn(5,2))
with .MailMerge
.OpenDataSource sn(5,3), "SELECT * FROM `TWD$`"

For j = 1 To ubound(sn)
.DataSource.FirstRecord = j
.DataSource.LastRecord = j
.Execute
.application.ActiveDocument.SaveAs sn(5,4) & "\" & sn(j,4) & "docx"
.application.ActiveDocument.Close 0
Next
End With

.Close 0
End Sub