1

New to VBA and initially my problem was to copy text in CSV file into string and then ultimately to a master workbook. I used the below code which works perfectly:

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

However, for some reason, it only copy pastes some of the files and not others (or maybe it overwrites it?, point is some of the files are not copied in). Not sure why this is the case? Is it because there are some blank cells in files? To rectify this, i replaced all blank cells with 0 - didn't work. Is it because of different copy paste area? Don't know how to rectify that if this is the case

So after long investigation, i found out an impractical approach where if you paste in files that you need to copy one by one, It does the trick but it is inefficient. So just for a temp solution, i did the following where vba code copies in a file from a temp folder to the source folder, does its job of copy pasting to the master work book and then deletes the file that was copied in. For some reason, the code stops at the first even though it's a Do while loop. Not sure what's the problem here and what is most efficient approach here?

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

new Code:

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
Piccinin
  • 103
  • 7
  • I don't have time for a full answer right now, but to get you started.... First block of code isn't updating the `lLastRow` variable. (If it is also size of destination range, there is a `.Resize()` method for ranges.) Second block of code, at the end of the first loop, the variable `strFilename` is being reset. Try `strFilename = Dir` without the "()". – Mistella Sep 10 '18 at 18:16
  • Hmm..will look into the resize option. Do you know why it's giving an error of invalid call procedure when i do strFilename=Dir? Sometimes it works but sometimes it doesnt – Piccinin Sep 10 '18 at 18:21
  • Not sure, when I haven't had a chance to deep-dive into your code, but here are a couple Q&A's that may be helpful.... (I also found some of the comments quite informative) https://stackoverflow.com/a/47061052/9259306, https://stackoverflow.com/a/10380381/9259306 – Mistella Sep 10 '18 at 19:57
  • So i followed the FSO code (shown in the post) and it's only copying in the first file. Do you know why? Curious as its should be copying in each F in the folder – Piccinin Sep 10 '18 at 20:16
  • Sometimes FSO/Dir objects act differently than expected do to either an extra or a missing blackslash. In the code I think you pulled from, to get the files, there wasn't a trailing backslash on the location string. There is in yours. Maybe try changing that? – Mistella Sep 10 '18 at 20:43
  • Unfortunately, tried different variations and stuck at it. But thanks for the help though – Piccinin Sep 11 '18 at 13:12
  • @Mistella, i caught the problem and solved it. Thank you for the help! – Piccinin Sep 11 '18 at 19:01

2 Answers2

0

You can simplify your code;

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
GMalc
  • 2,608
  • 1
  • 9
  • 16
  • Because of formating issues, i have to convert everything into a string and then paste it to a workbook – Piccinin Sep 11 '18 at 13:12
0

So i found out that Dir was the problem so i just removed dir in my main macro 

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
Piccinin
  • 103
  • 7