2017-07-04 2 views
0

Je suis en train de créer un bouton dans un. xlsm qui va convertir chacun des ~ .xlsx fichiers dans le myFolder en .txt. Le code VBA ci-dessous renvoie une erreur Expected End Sub. Les données sont toujours dans la 'Feuille 1' même si d'autres feuilles peuvent être présentesconvertir tous les fichiers xlsx dans le répertoire en texte

La commande Dos exécute et convertit les fichiers mais ils sont illisibles (quelque chose à voir avec le formatage excel?) Je ne sais pas quoi faire? Merci :)

Dos

cd C:\Users\Desktop\folder 
Copy *.xlsx *.txt 

VBA

Option Explicit 

Private Sub CommandButton1_Click() 


Dim oFSO, myFolder 
Dim xlText 

myFolder = "C:\Users\Desktop\folder" 


Set oFSO = CreateObject("Scripting.FileSystemObject") 
xlText = -4158 'Excel txt format enum 
Call ConvertAllExcelFiles(myFolder) 
Set oFSO = Nothing 

Call MsgBox("Done!") 


Sub ConvertAllExcelFiles(ByVal oFolder) 
Dim targetF, oFileList, oFile 
Dim oExcel, oWB, oWSH 

Set oExcel = CreateObject("Excel.Application") 
oExcel.DisplayAlerts = False 
Set targetF = oFSO.GetFolder(oFolder) 
Set oFileList = targetF.Files 
For Each oFile In oFileList 
If (Right(oFile.Name, 4) = "xlsx") Then 
    Set oWB = oExcel.Workbooks.Open(oFile.Path) 
    For Each oWSH In oWB.Sheets 
     Call oWSH.SaveAs(oFile.Path & ".txt", FileFormat:=xlTextWindows) 
    Next 
    Set oWSH = Nothing 
    Call oWB.Close 
    Set oWB = Nothing 
End If 
Next 
Call oExcel.Quit 
Set oExcel = Nothing 
End Sub 

Répondre

1

Les premières lignes de votre code appartiennent à Private Sub CommandButton1_Click()
(il doit être fermé par End Sub)

Option Explicit et indentation du code approprié peut aider dans cette situation

Essayez cette version:


Option Explicit 

Private Sub CommandButton1_Click() 
    Dim myFolder As String 

    myFolder = "C:\Users\Desktop\folder" 
    ConvertAllExcelFiles myFolder 
    MsgBox "Done!" 
End Sub 

Public Sub ConvertAllExcelFiles(ByVal folderPath As String) 
    Dim xlApp As Object, wb As Workbook, ws As Variant, fso As Object 
    Dim fileList As Object, itm As Object, fileName As String 

    Set fso = CreateObject("Scripting.FileSystemObject") 
    Set fileList = fso.GetFolder(folderPath).Files 
    Set xlApp = CreateObject("Excel.Application") 
    xlApp.DisplayAlerts = False 

    For Each itm In fileList 
     If Right(itm.Name, 4) = "xlsx" Then 
      Set wb = xlApp.Workbooks.Open(itm.Path) 
      fileName = fso.GetParentFolderName(itm.Path) & "\" & fso.GetBaseName(itm.Path) 
      If True Then 'if converting all sheets use For loop (Change True to False) 
       wb.Sheets(1).SaveAs fileName & ".txt", FileFormat:=xlTextWindows 
      Else 
       For Each ws In wb.Sheets 
        ws.SaveAs fileName & " - " & ws.Name & ".txt", FileFormat:=xlTextWindows 
       Next 
       Set ws = Nothing 
      End If 
      wb.Close: Set wb = Nothing 
     End If 
    Next 
    xlApp.Quit 
End Sub 

+1

Merci beaucoup :). – Chris

+1

Je suis content que cela ait aidé. J'ai fait de petits changements et amélioré les noms de fichiers texte: la version initiale a enregistré le fichier sous le nom de 'Book1.xlsx.txt' (maintenant il l'enregistre en tant que' Book1.txt') –