Convert Excel Files in Word for Comparison

[coeurdange57]

Hi,

I would like to convert Excel files from a folder (with possibility to choose the folder) into Word files (with possibility to choose the folder) in order to compare them. Could you please help me to do that?

I created a script in Excel for doing that from Excel, but I don't know if I can use it in Word for doing that from Word.




Sub export_workbook_to_word()
Dim sheetName As String
Set obj = CreateObject("Word.Application")
obj.Visible = True
Set newobj = obj.Documents.Add

For Each ws In ActiveWorkbook.Sheets
sheetName = ws.Name

'Retrieve name of the Worksheet
newobj.ActiveWindow.Selection.TypeText sheetName
newobj.ActiveWindow.Selection.Style = ActiveDocument.Styles(-2)
newobj.ActiveWindow.Selection.TypeParagraph

ws.UsedRange.Copy
newobj.ActiveWindow.Selection.PasteExcelTable False, False, False
newobj.ActiveWindow.Selection.InsertBreak Type:=7

Next
newobj.ActiveWindow.Selection.TypeBackspace
newobj.ActiveWindow.Selection.TypeBackspace

obj.Activate
newobj.SaveAs Filename:=Application.ActiveWorkbook.Path & "\" & Split(ActiveWorkbook.Name, ".")(0)

End Sub




Thanks in advance for your help

Regards,

[snb]

Crossposted/double posted: http://www.vbaexpress.com/forum/showthread.php?61549-Vba-Macro-in-Excel-for-exporting-multiples-files-in-Word-with-prompt

[gmayor]

This question is not quite the same as your other one, however it can be run from Word with a few changes. The bigger issue however is that Word is not directly compatible with excel tables and there is every possibility that the table may not fit the available space in Word.


Option Explicit

Sub export_workbook_to_word()
'Graham Mayor - http://www.gmayor.com - Last updated - 13 Dec 2017
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim oDoc As Document
Dim strPath As String
Dim strSavePath As String
Dim strWB As String
Dim strFile As String
Dim strSheetName As String
Dim i As Integer
Dim bStarted As Boolean
strPath = BrowseForFolder("Select the folder containing the workbooks to process")
If strPath = "" Then GoTo lbl_Exit
strSavePath = BrowseForFolder("Select the folder in which to save the document(s)")

On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err Then
bStarted = True
Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0

xlApp.Visible = True

strWB = Dir$(strPath & "*.xlsx")
While strWB <> ""
Set xlBook = xlApp.Workbooks.Open(strPath & strWB)
Set oDoc = Documents.Add
For Each xlSheet In xlBook.Sheets
xlSheet.usedrange.Copy
strSheetName = xlSheet.Name
oDoc.Activate
With oDoc.ActiveWindow.Selection
.EndKey wdStory
.TypeText strSheetName & vbCr
.PasteExcelTable False, False, False
.InsertBreak Type:=7
End With
Next xlSheet
oDoc.ActiveWindow.Selection.TypeBackspace
oDoc.ActiveWindow.Selection.TypeBackspace
If strSavePath = "" Then
strSavePath = strPath
End If
oDoc.SaveAs2 FileName:=strSavePath & Left(xlBook.Name, InStrRev(xlBook.Name, Chr(46))) & "docx"
oDoc.Close 0
xlBook.Close 0
strWB = Dir$()
Wend
If bStarted Then xlApp.Quit
lbl_Exit:
Set oDoc = Nothing
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
Exit Sub
End Sub

Private Function BrowseForFolder(Optional strTitle As String) As String
'Graham Mayor
'strTitle is the title of the dialog box
Dim fDialog As FileDialog
On Error GoTo err_Handler
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = strTitle
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then GoTo err_Handler:
BrowseForFolder = fDialog.SelectedItems.Item(1) & Chr(92)
End With
lbl_Exit:
Exit Function
err_Handler:
BrowseForFolder = vbNullString
Resume lbl_Exit
End Function

[coeurdange57]

thank you for your help :bow:

[macropod]

Please read VBA Express' policy on Cross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#faq_new_faq_item3