Option Explicit
Const MAX_PATH As Integer = 256
Sub ShowError(ByVal strDesc As String)
Dim strErr As String
If Err.Number > 0 Then
strErr = strDesc & vbCrLf & "Error Number: " & Str$(Err.Number) & vbCrLf & "Error Line: " & Str$(Erl)
Debug.Print strErr
MsgBox strErr, vbCritical Or vbOKOnly, Err.Source
Err.Clear
End If
End Sub
Sub taofile()
Dim ws As Worksheet
Dim doc As Object
Dim data As Variant
Dim WSF As Object
Dim n As Integer, j As Integer, lCol As Integer
Dim templatePath As String, strPath As String
Dim content As Object
Dim fso As Object, wordApp As Object
Application.ScreenUpdating = False
Set ws = ThisWorkbook.ActiveSheet
Set WSF = Application.WorksheetFunction
lCol = ws.Cells(3, Columns.Count).End(xlToLeft).Column
n = WSF.Count(ws.[A:A])
data = ws.[B3].Resize(n + 1, lCol)
strPath = ThisWorkbook.Path & "\Hoso\ho_so_TD\" & ws.[A2]
If (Len(strPath) + Len(ws.[A1]) + 1 >= MAX_PATH) Then strPath = ThisWorkbook.Path & "\Hoso\ho_so_TD\0"
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
1 If Not fso.FolderExists(strPath) Then
2 fso.CreateFolder strPath
If Err Then
ShowError "Khong the tao thu muc " & strPath
GoTo Finally
End If
End If
On Error GoTo Finally
strPath = strPath & "\" & ws.[A1]
templatePath = ThisWorkbook.Path & "\Maubieu\" & ws.[A1]
3 Set wordApp = CreateObject("Word.Application")
With wordApp
.Visible = False
4 Set doc = .Documents.Open(templatePath)
With doc
Set content = doc.content
For j = 1 To lCol
content.Find.Execute FindText:=ws.Cells(3, j).Value, ReplaceWith:=ws.Cells(4, j).Value, Replace:=2
Next j
5 .SaveAs strPath
End With
.Quit
End With
MsgBox "In Xong", vbInformation Or vbOKOnly
Finally:
If Err Then ShowError Err.Description
Application.ScreenUpdating = True
Set content = Nothing
Set doc = Nothing
Set wordApp = Nothing
Set fso = Nothing
End Sub
