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/show...rd-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

[macropod]

Please read VBA Express' policy on Cross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/faq...._new_faq_item3