我是否可以使用VBScript获取现有CSV并使其成为单个Excel工作簿的选项卡?

时间:2014-04-10 18:36:09

标签: excel csv vbscript scripting automation

我正在尝试自动化一个过程,在该过程中,我从一个目录中获取多个CSV,并在Excel工作簿中将它们分别设置为自己的选项卡,这样我就可以关闭它们的数据等。我试图尽可能避免使用宏...是否可以在VBScript中执行此操作? 以下是我到目前为止所尝试的内容,请原谅我的编程约定,因为我刚刚学习了VBS的基础知识:

Call createWkbk()

Function createWkbk()
strFileName = "c:\test1.xls"

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True

Set objWorkbook = objExcel.Workbooks.Add()

'Adds one spreadsheet to book for each command
objExcel.ActiveWorkbook.Worksheets.Add
objExcel.ActiveWorkbook.Worksheets.Add
objExcel.ActiveWorkbook.Worksheets.Add

'This renames all the sheets to 'int#'
objExcel.Sheets(1).Name = "int1"
objExcel.Sheets(2).Name = "int2"
objExcel.Sheets(3).Name = "int3"
objExcel.Sheets(4).Name = "int4"
objExcel.Sheets(5).Name = "int5"
objExcel.Sheets(6).Name = "int6"

'To save the book
objWorkbook.SaveAs(strFileName)

objExcel.Quit
End Function

所以现在我唯一需要做的就是将我已经拥有的那些CSV写入这些工作表,或者从一开始就将它们导入。如果没有在VBScript中,建议的路线是什么?

提前谢谢大家,

尼克

2 个答案:

答案 0 :(得分:2)

您可以使用QueryTable将CSV快速导入现有工作表:

Const strFile = "c:\test.csv"
Const strSheet = "Sheet1"

Set Sheet = objExcel.Sheets(strSheet)

With Sheet.QueryTables.Add("TEXT;" & strFile, Sheet.Range("A1"))
    .TextFileCommaDelimiter = True
    .Refresh
End With

答案 1 :(得分:-2)

您也可以尝试一下,这是我找到并适合我使用的代码:

Sub ImportXlsSheets()

'On crée une variable 'wbFusion' de type Classeur Excel
Dim wbFusion As Workbook
'On l'associe au classeur à partir duquel tu lances la macro
Set wbFusion = ThisWorkbook

'On crée une variable wbCible qui va correspondre tour à tour aux classeur à importer
Dim wbCible As Workbook
Dim shCible As Worksheet

'Afin de lui affecter des fichiers, l'utilisateur va les sélectionner via une boîte de dialogue
'NOTA : le With XXXXXXXXX évite de répéter plein de fois XXXXXXXXX lorsque l'on parle de la même chose ;)
With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Choisissez le(s) classeur(s) à importer"
    .Filters.Add "Classeur Excel", "*.xls,*.xls?" 'on filtre par tous les fichiers .xls et xls? avec '?' signifiant "1 caractère"
    .ButtonName = "Importer ce(s) classeur(s)"
    .AllowMultiSelect = True 'on autorise la sélection multiple
    .Show 'on affiche la fenêtre, on attend le retour de l'utilisateur pour continuer

    'on a réglé la boîte de dialogue, maintenant il faut traiter les données de l'utilisateur :
    'si l'utilisateur n'a pas sélectionné de fichier, on met un message d'erreur
    If .SelectedItems.Count = 0 Then
        MsgBox "Veuillez sélectionner au moins un fichier", vbExclamation, "Erreur"
    'Sinon, on traite :
    Else
        For i = 1 To .SelectedItems.Count
            'On ouvre chaque classeur un par un
            Set wbCible = Workbooks.Open(.SelectedItems(i))
            CouleurOnglet = RGB(Rnd * 255, Rnd * 255, Rnd * 255) 'on va mettre toutes les pages de ce classeur importées avec l'onglet de la même couleur
            CompteurClasseur = CompteurClasseur + 1 'on incrémente un compteur, facultatif
            'Pour chaque feuille du wbCible :
            For Each shCible In wbCible.Sheets
                shCible.Tab.Color = CouleurOnglet
                'shCible.Name = Int(Rnd * 99999) 'nom aléatoire pour être certain qu'il n'y ait pas de doublon plantant la macro
                shCible.Name = i & "_" & shCible.Name ' To keep the original sheet name and concatenate it with its order
                shCible.Copy after:=wbFusion.Sheets(wbFusion.Sheets.Count) 'on la copie à la fin de wbFusion
                CompteurFeuille = CompteurFeuille + 1 'on incrémente un compteur, facultatif
            Next shCible
            'On ferme le classeur sans enregistrer (on a changé le nom des pages avant copie)
            wbCible.Close SaveChanges:=False
        'On passe au classeur suivant
        Next i
        'Facultatif, à l'aide des compteurs, on indique à l'utilisateur que tout s'est bien passé
        MsgBox CompteurFeuille & " feuilles ont bien été importées, provenant de " & CompteurClasseur & " classeurs Excel.", vbInformation, "Import réussi"
    End If
End With

End Sub