时间戳

首页 > 解决方案 > VBA 代码循环遍历 .csv 文件的文件夹，将数据粘贴到 xlsx 模板中并另存为 .xlsx

excel - VBA 代码循环遍历 .csv 文件的文件夹，将数据粘贴到 xlsx 模板中并另存为 .xlsx

问题描述

VBA代码不循环通过.csv的文件夹

下面的代码正在执行我需要的功能，但没有循环，最好添加一行来删除 .csv 的复制

Option Explicit

Private Sub SaveAs_Files_in_Folder()

    Dim CSVfolder As String, XLSfolder As String
    Dim CSVfilename As String, XLSfilename As String
    Dim template As String
    Dim wb As Workbook
    Dim wbm As Workbook 'The template I want the data pasted into


    Dim n As Long


    CSVfolder = "H:\Case Extracts\input"    'Folder I have the csv's go
    XLSfolder = "H:\Case Extracts\output"    'Folder for the xlsx output


    If Right(CSVfolder, 1) <> "\" Then CSVfolder = CSVfolder & "\"
    If Right(XLSfolder, 1) <> "\" Then XLSfolder = XLSfolder & "\"

    n = 0

    CSVfilename = Dir(CSVfolder & "*.csv", vbNormal)

    template = Dir("H:\Case Extracts\template.xlsx", vbNormal) 

    While Len(CSVfilename) <> 0
        n = n + 1

        Set wb = Workbooks.Open(CSVfolder & CSVfilename)
        Range("A1:M400").Select
        Selection.Copy


        Set wbm = Workbooks.Open(template, , , , "Password") 'The template has a password          
        With wbm
                Worksheets("Sheet2").Activate
                Sheets("Sheet2").Cells.Select
                Range("A1:M400").PasteSpecial  
                Worksheets("Sheet1").Activate
                Sheets("Sheet1").Range("A1").Select

                wbm.SaveAs Filename:=XLSfolder & CSVfilename & ".xlsx", FileFormat:=xlOpenXMLWorkbook
                wbm.Close
         End With
         With wb
                .Close False
         End With

         CSVfilename = Dir()  

    Wend

End Sub

该代码适用于第一个 .csv 文件，我只是无法让循环继续浏览这些文件。复制后添加一行以删除 .csv 也很好

标签： excelvbaloopscsv

解决方案

  1. 处理对象。您可能想了解如何避免在 Excel VBA 中使用 Select。为 csv 和模板声明对象并使用它们。
  2. 你DIR不工作，因为template = Dir("H:\Case Extracts\template.xlsx", vbNormal)它就在之后CSVfilename = Dir(CSVfolder & "*.csv", vbNormal)。它正在重置。反转位置，如下图所示。正如@AhmedAU 提到的，将它移到循环之前。
  3. 仅在准备粘贴时复制范围。Excel 有一个奇怪的习惯是清除剪贴板。例如，我在复制范围后立即粘贴。

这是你正在尝试的吗？（未经测试）

Option Explicit

Private Sub SaveAs_Files_in_Folder()
    Dim CSVfolder As String, XLSfolder As String
    Dim CSVfilename As String, XLSfilename As String
    Dim wbTemplate As Workbook, wbCsv As Workbook
    Dim wsTemplate As Worksheet, wsCsv As Worksheet

    CSVfolder = "H:\Case Extracts\input"    '<~~ Csv Folder
    XLSfolder = "H:\Case Extracts\output"   '<~~ For xlsx output

    If Right(CSVfolder, 1) <> "\" Then CSVfolder = CSVfolder & "\"
    If Right(XLSfolder, 1) <> "\" Then XLSfolder = XLSfolder & "\"

    XLSfilename = Dir("H:\Case Extracts\template.xlsx", vbNormal)
    CSVfilename = Dir(CSVfolder & "*.csv")

    Do While Len(CSVfilename) > 0
        '~~> Open Csv File
        Set wbCsv = Workbooks.Open(CSVfolder & CSVfilename)
        Set wsCsv = wbCsv.Sheets(1)

        '~~> Open Template file
        Set wbTemplate = Workbooks.Open(XLSfolder & XLSfilename, , , , "Password")
        '~~> Change this to relevant sheet
        Set wsTemplate = wbTemplate.Sheets("Sheet1")

        '~~> Copy and paste
        wsCsv.Range("A1:M400").Copy
        wsTemplate.Range("A1").PasteSpecial xlPasteValues

        '~~> Save file
        wbTemplate.SaveAs Filename:=XLSfolder & CSVfilename & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook

        '~~> Close files
        wbTemplate.Close (False)
        wbCsv.Close (False)

        '~~> Get next file
        CSVfilename = Dir
    Loop

    '~~> Clear clipboard
    Application.CutCopyMode = False
End Sub

推荐阅读