Question

VBA的新手，最初我的问题是将CSV文件中的文本复制到字符串中，然后最终复制到主工作簿中。我使用了下面的代码，效果很好：

Sub Compiler()

    Dim handle As Integer
    Dim wbDst As Workbook
    Dim wsDst As Worksheet
    Dim lLastRow As Long
    Dim MyPath As String
    Dim strFilename As String

    handle = FreeFile
    Set wbDst = ThisWorkbook
    Set wsDst = wbDst.Worksheets("First Sheet")
    lLastRow = wsDst.UsedRange.Rows(wsDst.UsedRange.Rows.Count).Row + 1

    Sheets("First Sheet").Columns(1).NumberFormat = "@"
    Sheets("First Sheet").Columns(2).NumberFormat = "@"
    Sheets("First Sheet").Columns(3).NumberFormat = "@"

    MyPath = "W:\Test Folder\"
    strFilename = Dir(MyPath, vbNormal)

    Do While strFilename <> ""
    Dim buffer As String
        Open MyPath & strFilename For Input As #handle
        buffer = Input(LOF(handle), handle)  '<-- reads the entire contents of the file to "buffer"
        Close #handle

        With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
            .SetText buffer
            .PutInClipboard
        End With

        wsDst.Paste wsDst.Range("A" & lLastRow)

        'Application.CutCopyMode = False
        strFilename = Dir()
    Loop

End Sub

但是，由于某种原因，它仅复制粘贴某些文件，而不粘贴其他文件（或者可能会覆盖它？，指向某些文件未复制到其中）。不确定为什么会这样吗？是因为文件中有一些空白单元格吗？为了解决这个问题，我将所有空白单元格都替换为0-无效。是因为复制粘贴区域不同吗？如果是这种情况，不知道该如何纠正

因此，经过长时间的研究，我发现了一种不切实际的方法，即如果您粘贴需要逐个复制的文件，则可以达到目的，但效率低下。因此，仅对于临时解决方案，我执行了以下操作，其中vba代码将文件从临时文件夹复制到源文件夹，将其复制粘贴到主工作簿中，然后删除复制到其中的文件。因此，即使是Do while循环，代码也会在第一个位置停止。不知道这是什么问题，什么是最有效的方法？

Sub ISINCompiler()

    'Declare Variables
    Dim FSO
    Dim MyPath As String
    Dim strFilename As String
    Dim sFile As String
    Dim sSFolder As String
    Dim sDFolder As String

    Application.DisplayAlerts = False

    MyPath = "C:\Users\Tomhardy\Desktop\ISIN-Compiler Temp\"
    strFilename = Dir(MyPath, vbNormal)

    'This is Your File Name which you want to Copy
    'Change to match the destination folder path
    sDFolder = "W:\Test Folder\"

    'Create Object
    Set FSO = CreateObject("Scripting.FileSystemObject")

    'Checking If File Is Located in the Source Folder
    Do While strFilename <> ""
        If Not FSO.FileExists(MyPath & strFilename) Then
            MsgBox "Specified File Not Found", vbInformation, "Not Found"

            'Copying If the Same File is Not Located in the Destination Folder
        ElseIf Not FSO.FileExists(sDFolder & strFilename) Then
            FSO.CopyFile (MyPath & strFilename), sDFolder, True
            ISINCompilerx2  '<-Copying and pasting in text
            DeleteExample1 '<-Deleting the file after it has been copied in

        Else
            MsgBox "Specified File Already Exists In The Destination Folder", 
            vbExclamation, "File Already Exists"
        End If

        strFilename = Dir()
    Loop

End Sub


Private Sub ISINCompilerx2()

    Dim handle As Integer
    Dim wbDst As Workbook
    Dim wsDst As Worksheet
    Dim lLastRow As Long
    Dim someotherpath As String
    Dim somestrFilename As String

    handle = FreeFile
    Set wbDst = ThisWorkbook
    Set wsDst = wbDst.Worksheets("First Sheet")
    lLastRow = wsDst.UsedRange.Rows(wsDst.UsedRange.Rows.Count).Row + 1

    Sheets("First Sheet").Columns(1).NumberFormat = "@"
    Sheets("First Sheet").Columns(2).NumberFormat = "@"
    Sheets("First Sheet").Columns(3).NumberFormat = "@"

    someotherpath = "W:\Test Folder\"
    somestrFilename = Dir(someotherpath, vbNormal)

    Do While somestrFilename <> ""
        Dim buffer As String
        Open someotherpath & somestrFilename For Input As #handle
        buffer = Input(LOF(handle), handle)  '<-- reads the entire 
        contents of the file to "buffer"
        Close #handle

        With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
            .SetText buffer
            .PutInClipboard
        End With

        wsDst.Paste wsDst.Range("A" & lLastRow)
        Application.CutCopyMode = False
        somestrFilename = Dir()

    Loop

End Sub

Private Sub DeleteExample1()

    On Error Resume Next
    Kill "W:\Test Folder\*.*"
    On Error GoTo 0

End Sub

新代码：

Sub ISINCompiler()
'Declare Variables
 Dim FSO As Object
 Dim MyPath As String
 Dim strFilename As String
Dim f As Object
Dim sDFolder As String
 Application.DisplayAlerts = False
MyPath = "C:\Users\Tomhardy\Desktop\ISIN-Compiler Temp\"
strFilename = Dir(MyPath, vbNormal)
 'This is Your File Name which you want to Copy
'Change to match the destination folder path
 sDFolder = "W:\Destination folder\"
  '     Create Object
  Set FSO = CreateObject("Scripting.FileSystemObject")
'Checking If File Is Located in the Source Folder
  For Each f In FSO.GetFolder(MyPath).Files
  If Not FSO.FileExists(MyPath & strFilename) Then
 MsgBox "Specified File Not Found", vbInformation, "Not Found"

'Copying If the Same File is Not Located in the Destination Folder
ElseIf Not FSO.FileExists(sDFolder & strFilename) Then
  FSO.CopyFile (MyPath & strFilename), sDFolder, True
'ISINCompilerx2
 'DeleteExample1
   MsgBox "Specified File Copied Successfully", vbInformation, "Done!"
  Else
  MsgBox "Specified File Already Exists In The Destination Folder", 
  vbExclamation, "File Already Exists"
End If
Next f
Set f = Nothing
Set FSO = Nothing
End Sub

Answer 1

您可以简化代码；

Dim Filename As String
Dim lLastRow As Long
Dim wsDst As Worksheet

Set wsDst = ThisWorkbook.Worksheets("First Sheet")
Filename = Dir("W:\Test Folder\*.csv")

    Do While Filename <> ""
        Set wbSrce = Workbooks.Open(Filename)
        lLastRow = wsDst.UsedRange.Rows.Count + 1
            wbSrce.Sheets(1).UsedRange.Copy wsDst.Range("A" & lLastRow)
            wbSrce.Close savechanges:=False
        Filename = Dir
    Loop

Answer 2

所以我发现Dir是问题所在，所以我只是在主宏中删除了dir

Option Explicit
 Public wbDst As Workbook
Public wsDst As Worksheet
Sub ISINCompiler()
'Declare Variables
Set wbDst = ThisWorkbook
Set wsDst = wbDst.Worksheets("First Sheet")
 Dim i As Long
Dim myFSO As FileSystemObject
Dim xFolder As Scripting.Folder
 Dim FSO As Object
Dim f
  Dim MyPath As String
 Dim sDFolder As String
Application.DisplayAlerts = False
sDFolder = "W:\Destination\"

 Set FSO = CreateObject("Scripting.FileSystemObject")
Set myFSO = New FileSystemObject
  Set xFolder = myFSO.GetFolder("C:\Source")
   'Checking If File Is Located in the Source Folder
   For Each f In xFolder.Files
 f.Copy sDFolder & f.Name
 MsgBox "Specified File Copied Successfully", vbInformation, "Done!"
ISINCompilerx2
DeleteExample1
Next f
  End Sub

   Private Sub ISINCompilerx2()
  Dim handle As Integer
  Dim lLastRow As Long
Dim somePath As String
  Dim someFilename As String
 handle = FreeFile
  lLastRow = wsDst.UsedRange.Rows(wsDst.UsedRange.Rows.Count).Row + 1
  Sheets("First Sheet").Columns(1).NumberFormat = "@"
 Sheets("First Sheet").Columns(2).NumberFormat = "@"
 Sheets("First Sheet").Columns(3).NumberFormat = "@"

 somePath = "W:\Destination\"
 someFilename = Dir(somePath, vbNormal)
  Dim buffer As String
 Open somePath & someFilename For Input As #handle
 buffer = Input(LOF(handle), handle)  '<-- reads the entire contents of 
 the file to "buffer"
Close #handle

With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText buffer
.PutInClipboard
End With

wsDst.Paste wsDst.Range("A" & lLastRow)
  Application.CutCopyMode = False
 End Sub

 Private Sub DeleteExample1()
'You can use this to delete all the files in the folder Test
 On Error Resume Next
 Kill "W:\Destination\*.*"
On Error GoTo 0
 End Sub

在我的Do while循环中遇到问题

2 个答案: