Consolidate macros

Asked

Viewed 114 times

2

I need to create a macro that allows me to choose all . xml files and import them into excel. At the moment the process is as follows: - I open the first one manually and then call the macro that imports all the other selected ones. I wanted to know how I can perform all these steps with just one macro.

Sub Import1()
Dim wb As Workbook
Dim instance As XPath
Dim Map As XmlMap
Dim XPath As String

ChDir "C:\rwindows"
With ActiveWorkbook.XmlMaps("evs_rpb_Mapa")
    .ShowImportExportValidationErrors = False
    .AdjustColumnWidth = True
    .PreserveColumnFilter = True
    .PreserveNumberFormatting = True
    .AppendOnImport = True
 End With

fileToOpen = Application _
.GetOpenFilename("XML Files (*.xml), *.xml", , "Import XML", , True)

Application.DisplayAlerts = False
If IsArray(fileToOpen) Then
    For Each fil In fileToOpen



    ActiveWorkbook.XmlMaps("evs_rpb_Mapa").Import URL:=fil

    Next fil
Else
    Exit Sub
End If
Application.DisplayAlerts = True

End Sub

My knowledge is none. If anyone can help, I’d appreciate it. Thank you.

  • It’s been a while and I haven’t heard back. If anyone knows how I can get around this situation I’d appreciate it.

1 answer

0

Here’s an excerpt of the code I use to basically do what you want:

  1. Opens a selection window
  2. User selects a spreadsheet
  3. Excel opens the selected worksheet, copies the data and closes the selected worksheet.

Note that I have restricted that the user selects only one file in .AllowMultiSelect = False, but you can enable this and save all names in an array and repeat the import process in one for.

    Dim fd As Office.FileDialog

    Set fd = Application.FileDialog(msoFileDialogFilePicker)

       With fd
      .AllowMultiSelect = False

      .Title = "Selecione a planilha de NFs."

      .Filters.Clear
      .Filters.Add "Excel 2016", "*.xls"
      .Filters.Add "Todos os arquivos", "*.*"

      If .Show = True Then
        txtFileName = .SelectedItems(1)
      Else
        Exit Sub
      End If
     End With

    Dim Target_Workbook As Workbook
    Dim Source_Workbook As Workbook

    Set Target_Workbook = Workbooks.Open(txtFileName)
    Set Source_Workbook = ThisWorkbook

    LRow = LCell(Target_Workbook.Sheets(1)).Row
    LCol = LCell(Target_Workbook.Sheets(1)).Column

    For i = 1 To LRow
        For d = 1 To LCol

            Target_Data = Target_Workbook.Sheets(1).Cells((3 + i), d)
            Source_Workbook.Sheets(3).Cells((1 + i), d) = Target_Data

        Next d
    Next i

    Source_Workbook.Save
    Target_Workbook.Save
    Target_Workbook.Close False

Browser other questions tagged

You are not signed in. Login or sign up in order to post.