Question

我希望从位于同一文件夹中的多个excel文件导入数据。每天都会将新文件添加到该文件夹中。我每周或每月导入一次数据，需要一个循环，从我尚未导入的文件中导入所有数据。目前我使用了以下代码，但我必须进入并为每个文件重新键入文件名以获取新数据。请帮忙吗？

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Open Filename:="H:\global\Prosjekt\NAS\RCL\OUTPUT-20150302.csv"
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("yield1.xlsm").Activate
Sheets("Input").Select
Range("A9").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("A9"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
    Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True


Windows("OUTPUT-20150302.csv").Activate
ActiveWindow.Close

'XYZ
Sheets("Input").Select
 Range("R8:R204").Select
 Selection.Copy
 Sheets("XYZ").Select
   Range("xfd1:xfd197").End(xlToLeft).Offset(0, 1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

Answer 1

在VBA中有一个名为Dir(pathname, attributes)的函数。

您可以在此处找到参考：Function Reference

您将定义FileList as Variant，然后使用Dir函数设置它：FileList = Dir("c:\YourFolder\)

之后，您可以使用FileList这样的循环遍历While (FileList <> "") Excel文件

阅读文件后，您可以将您在文本文件中阅读的文件存储起来，这样就不会遇到重复文件。

Answer 2

这可能是你想要的：

Durgun在代码中的答案：

Dim CurrentFilePath As Variant '<-- ADDED
Dim wkbOpenedWorkbook As Workbook '<-- ADDED
Dim SelectionB4 as Range '<-- ADDED
Const sDIR As String = "H:\global\Prosjekt\NAS\RCL\*.csv" '<-- ADDED, note: "*.csv" is filter for your files
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set SelectionB4 = Range(Selection, Selection.End(xlDown))'<-- moved/changed, save reference to your 1 selection
CurrentFilePath = Dir(sDIR) '<-- ADDED
While CurrentFilePath <> "" '<-- ADDED
    Set wkbOpenedWorkbook = Workbooks.Open(Filename:=CurrentFilePath) '<-- CHANGED, save reference to workbook, to close it later
    SelectionB4.Select
    Selection.Copy
    Windows("yield1.xlsm").Activate
    Sheets("Input").Select
    Range("A9").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("A9"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True


    wkbOpenedWorkbook.Close False '<-- CHANGED 'close and dont save, remove "False" to popup the save dialog

    'XYZ
    Sheets("Input").Select
     Range("R8:R204").Select
     Selection.Copy
     Sheets("XYZ").Select
       Range("xfd1:xfd197").End(xlToLeft).Offset(0, 1).Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    CurrentFilePath = Dir(sDIR) '<-- ADDED
Wend '<-- ADDED

注意：代码中有很多地方需要优化，使其更稳定，更快速，更易读。

从文件夹中的新excel文件导入数据（每天添加到文件夹的新文件）

2 个答案: