Losing data through csv file opening loop vba

Question

I got CSV dataset every day from 5 partners after 8PM. The files are in the same structure, the range of the size 4- 130 KB in the same folder. I want to merge all files to one by macro, the today result is days from 10-15th are missing. Data of 16th (the last day) are good. When I run the macro for only one partner, I get full result. What can be the problem?

Dim MyFolder As String
Dim MyFile As String
Dim last As Integer
Dim newrow As Integer
Dim sh As Worksheet
Dim name As String
Dim name2 As String
Dim myYear As Variant
Dim myMonth As Variant

Sheets("Munka1").Select
name = ActiveWorkbook.name

ScreenUpdating = False
Range(Cells(2, 1), Cells(300000, 200)).Select
Selection.Clear
Cells(2, 1).Select


MyFolder = "InputFolder"
MyFile = Dir(MyFolder & "\FILE_*" & "*.csv")

Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile, Local:=True
name2 = ActiveWorkbook.name
On Error Resume Next

Range(Cells(2, 1), Cells(3000, 11)).Select
Selection.Copy

Windows(name).Activate
Cells(newrow, 1).Select
ActiveSheet.Paste

last= Range("A1", Range("A1").End(xlDown)).Rows.Count
newrow = last + 1

Application.CutCopyMode = False
Windows(name2).Close savechanges:=False

MyFile = Dir
Loop

I added the code but it must be capacity problem or just another black hole in the microsoft universe — Danhadnagy, Dec 18 '19 at 09:59
remove this line `On Error Resume Next` and you'l find out about the error. Also, reference the workbook you are opening so `set w=workbooks.open(...` then in this line `Range("A1", Range("A1").End(xlDown)).Rows.Count` you can make sure you're on the correct book and sheet — Nathan_Sav, Dec 18 '19 at 10:10

score 0 · Answer 1 · answered Dec 23 '19 at 20:27

Can you try it like this and feedback?

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function OpenProcess Lib "kernel32" _
        (ByVal dwDesiredAccess As Long, _
        ByVal bInheritHandle As Long, _
        ByVal dwProcessId As Long) As Long

    Private Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" _
        (ByVal hProcess As Long, _
        lpExitCode As Long) As Long
#Else
    Private Declare Function OpenProcess Lib "kernel32" _
        (ByVal dwDesiredAccess As Long, _
        ByVal bInheritHandle As Long, _
        ByVal dwProcessId As Long) As Long

    Private Declare Function GetExitCodeProcess Lib "kernel32" _
        (ByVal hProcess As Long, _
        lpExitCode As Long) As Long
#End If


Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103


Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
    Dim hProg As Long
    Dim hProcess As Long, ExitCode As Long
    'fill in the missing parameter and execute the program
    If IsMissing(WindowState) Then WindowState = 1
    hProg = Shell(PathName, WindowState)
    'hProg is a "process ID under Win32. To get the process handle:
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
    Do
        'populate Exitcode variable
        GetExitCodeProcess hProcess, ExitCode
        DoEvents
    Loop While ExitCode = STILL_ACTIVE
End Sub


Sub Merge_CSV_Files()
    Dim BatFileName As String
    Dim TXTFileName As String
    Dim XLSFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim DefPath As String
    Dim Wb As Workbook
    Dim oApp As Object
    Dim oFolder
    Dim foldername

    'Create two temporary file names
    BatFileName = Environ("Temp") & _
            "\CollectCSVData" & Format(Now, "dd-mm-yy-h-mm-ss") & ".bat"
    TXTFileName = Environ("Temp") & _
            "\AllCSV" & Format(Now, "dd-mm-yy-h-mm-ss") & ".txt"

    'Folder where you want to save the Excel file
    DefPath = Application.DefaultFilePath
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If

    'Set the extension and file format
    If Val(Application.Version) < 12 Then
        'You use Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007 or higher
        FileExtStr = ".xlsx": FileFormatNum = 51
        'If you want to save as xls(97-2003 format) in 2007 use
        'FileExtStr = ".xls": FileFormatNum = 56
    End If

    'Name of the Excel file with a date/time stamp
    XLSFileName = DefPath & "MasterCSV " & _
                  Format(Now, "dd-mmm-yyyy h-mm-ss") & FileExtStr

    'Browse to the folder with CSV files
    Set oApp = CreateObject("Shell.Application")
    Set oFolder = oApp.BrowseForFolder(0, "Select folder with CSV files", 512)
    If Not oFolder Is Nothing Then
        foldername = oFolder.Self.Path
        If Right(foldername, 1) <> "\" Then
            foldername = foldername & "\"
        End If

        'Create the bat file
        Open BatFileName For Output As #1
        Print #1, "Copy " & Chr(34) & foldername & "*.csv" _
                & Chr(34) & " " & TXTFileName
        Close #1

        'Run the Bat file to collect all data from the CSV files into a TXT file
        ShellAndWait BatFileName, 0
        If Dir(TXTFileName) = "" Then
            MsgBox "There are no csv files in this folder"
            Kill BatFileName
            Exit Sub
        End If

        'Open the TXT file in Excel
        Application.ScreenUpdating = False
        Workbooks.OpenText Filename:=TXTFileName, Origin:=xlWindows, StartRow _
                :=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
                ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, _
                Space:=False, Other:=False

        'Save text file as a Excel file
        Set Wb = ActiveWorkbook
        Application.DisplayAlerts = False
        Wb.SaveAs Filename:=XLSFileName, FileFormat:=FileFormatNum
        Application.DisplayAlerts = True

        Wb.Close savechanges:=False
        MsgBox "You find the Excel file here: " & vbNewLine & XLSFileName

        'Delete the bat and text file you temporary used
        Kill BatFileName
        Kill TXTFileName

        Application.ScreenUpdating = True
    End If
End Sub

https://www.rondebruin.nl/win/s3/win021.htm

score -1 · Answer 2 · answered Dec 18 '19 at 11:26

-1

I just had to change last and newraw variable to long.

answered Dec 18 '19 at 11:26

Danhadnagy

19
9

Losing data through csv file opening loop vba

2 Answers2