Komponent / plugin

Du kan bruge denne makro.

//akj

Option Explicit
Sub convertcsv()

Dim myfiles() As String
Dim i As Integer
Dim myfile As String
Dim myfolder As String
Dim strpath As String
Dim strfilename As String

Dim wks As Worksheet

myfolder = "C:\temp"

    With Application.FileSearch
        .NewSearch
        .LookIn = myfolder
        .SearchSubFolders = True
        .Filename = "*.xls"
        If .Execute() > 0 Then
            ReDim Preserve myfiles(1 To .FoundFiles.Count)
            Application.StatusBar = "Found Files:  " & .FoundFiles.Count
            For i = 1 To .FoundFiles.Count
                myfiles(i) = .FoundFiles(i)
            Next i
        Else
            MsgBox "There were no files found."
            Exit Sub
        End If
       
    End With

    For i = LBound(myfiles) To UBound(myfiles)
        Application.StatusBar = "Processing #" & i & ":  " & myfiles(i)
       
        Workbooks.Open Filename:=myfiles(i), ReadOnly:=True
       
        For Each wks In ActiveWorkbook.Worksheets
            wks.Activate
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs _
                Filename:=Left(myfiles(i), Len(myfiles(i)) - 4) & "_" _
  & wks.Name, _
                FileFormat:=xlCSV
            Application.DisplayAlerts = True
        Next wks
       
        ActiveWorkbook.Close savechanges:=False
       
    Next i
   
    Application.StatusBar = False

End Sub

tak