winw123456
Thành viên mới

- Tham gia
- 10/10/24
- Bài viết
- 1
- Được thích
- 0
Em chào mọi người, em đang thực tập tại một công ty và họ yêu cầu em nghiên cứu cách chuyển nhiều file Word sang PDF. Em cũng tìm thấy đoạn code này trên internet, giống với 1 anh đã từng có bài hỏi như này rồi ạ.
Nguồn nó ở đây: https://gitiho.com/blog/cach-chuyen-doi-doc-sang-docx-va-word-sang-pdf-hang-loat-dong-thoi.html
Sub ConvertWordsToPdfs()
'Updated by Extendoffice 20181123
Dim xIndex As String
Dim xDlg As FileDialog
Dim xFolder As Variant
Dim xNewName As String
Dim xFileName As String
Set xDlg = Application.FileDialog(msoFileDialogFolderPicker)
If xDlg.Show <> -1 Then Exit Sub
xFolder = xDlg.SelectedItems(1) + "\"
xFileName = Dir(xFolder & "*.*", vbNormal)
While xFileName <> ""
If ((Right(xFileName, 4)) <> ".doc" Or Right(xFileName, 4) <> ".docx") Then
xIndex = InStr(xFileName, ".") + 1
xNewName = Replace(xFileName, Mid(xFileName, xIndex), "pdf")
Documents.Open FileName:=xFolder & xFileName, _
ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
wdOpenFormatAuto, XMLTransform:=""
ActiveDocument.ExportAsFixedFormat OutputFileName:=xFolder & xNewName, _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
ActiveDocument.Close
End If
xFileName = Dir()
Wend
End Sub
Em cũng làm theo đúng như hướng dẫn, nhưng khi chọn folder chứa các file word thì nó luôn báo folder này rỗng, không có file word nào cả. Sau khi đọc cmt bài của anh đấy thì em đã khắc phục được lỗi này bằng cách sửa dòng này : Set xDlg = Application.FileDialog(msoFileDialogFolderPicker) thành Set xDlg = Application.FileDialog(msoFileDialogFilePicker).
Nhưng khi chọn file word thì báo lỗi Run-time error 52 Bad file name or number thì bây giờ em nên làm gì ạ. Máy em là word 2007. Em cảm ơn rất nhiều
Nguồn nó ở đây: https://gitiho.com/blog/cach-chuyen-doi-doc-sang-docx-va-word-sang-pdf-hang-loat-dong-thoi.html
Sub ConvertWordsToPdfs()
'Updated by Extendoffice 20181123
Dim xIndex As String
Dim xDlg As FileDialog
Dim xFolder As Variant
Dim xNewName As String
Dim xFileName As String
Set xDlg = Application.FileDialog(msoFileDialogFolderPicker)
If xDlg.Show <> -1 Then Exit Sub
xFolder = xDlg.SelectedItems(1) + "\"
xFileName = Dir(xFolder & "*.*", vbNormal)
While xFileName <> ""
If ((Right(xFileName, 4)) <> ".doc" Or Right(xFileName, 4) <> ".docx") Then
xIndex = InStr(xFileName, ".") + 1
xNewName = Replace(xFileName, Mid(xFileName, xIndex), "pdf")
Documents.Open FileName:=xFolder & xFileName, _
ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
wdOpenFormatAuto, XMLTransform:=""
ActiveDocument.ExportAsFixedFormat OutputFileName:=xFolder & xNewName, _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
ActiveDocument.Close
End If
xFileName = Dir()
Wend
End Sub
Em cũng làm theo đúng như hướng dẫn, nhưng khi chọn folder chứa các file word thì nó luôn báo folder này rỗng, không có file word nào cả. Sau khi đọc cmt bài của anh đấy thì em đã khắc phục được lỗi này bằng cách sửa dòng này : Set xDlg = Application.FileDialog(msoFileDialogFolderPicker) thành Set xDlg = Application.FileDialog(msoFileDialogFilePicker).
Nhưng khi chọn file word thì báo lỗi Run-time error 52 Bad file name or number thì bây giờ em nên làm gì ạ. Máy em là word 2007. Em cảm ơn rất nhiều