Удалить строки из выходного файла .CSV - PullRequest
0 голосов
/ 25 мая 2020

Может кто-нибудь посмотреть в этом коде. Он объединяет файлы .csv в один файл. Я бы хотел, чтобы эта 1-я строка каждого .csv не принималась во внимание, потому что это релевантная информация, и я должен удалить ее вручную из нового объединенного файла. Также мне хотелось бы получить некоторые пояснения по новому коду (я новичок в VBA, но хотел бы узнать) Возможно ли это, пожалуйста?

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 _
                :=2, 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 "Your Excel file is here: " & vbNewLine & XLSFileName

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

        Application.ScreenUpdating = True
    End If
End Sub

СПАСИБО

1 Ответ

0 голосов
/ 25 мая 2020

Вы ничего не говорите, и я должен покинуть офис ... Пожалуйста, проверьте следующий код. Предполагается, что мои вышеупомянутые предположения (в комментарии) верны. Код прокомментирован таким образом, чтобы вы поняли его значение. Он использует стандартные функции VBA / VBScript. Никаких вызовов API и файлов bat ... Это исключает первую строку csv из процесса слияния.

Код прокомментирован таким образом, чтобы его было легко понять. Если что-то непонятно, не стесняйтесь обращаться за разъяснениями!

Sub testMeergeCSVFiles()
    Dim fullFilename As String, objFSO As Object, objTF As Object, arrIn As Variant
    Dim masterFullName As String, i As Long, strIn As String, strExt As String
    Dim finStr As String, foldName As String, wb As Workbook, xlsFullName As String

    masterFullName = Environ("TEMP") & "\" & Format(Now, "dd-mm-yy-h-mm-ss") & ".csv"
    xlsFullName = Application.DefaultFilePath & "\" & "MasterCSV " & _
                                Format(Now, "dd-mmm-yyyy h-mm-ss") & ".xlsx"
    foldName = GetFolderPath(ThisWorkbook.path & "\") ' it uses GetFolderPath function, starting from
                                                      ' ThisWorkbook path
    fullFilename = Dir(foldName & "\" & "*.csv") 'iterate in folder for csv files
    Do While fullFilename <> ""
        'If left(fullFilename, 9) = "TestMerge" Then 'only for testing reason (for me)
            Set objFSO = CreateObject("Scripting.FileSystemObject")
            Set objTF = objFSO.OpenTextFile(foldName & "\" & fullFilename, 1)
                strIn = objTF.ReadAll 'extract all the content of the file
            objTF.Close

            arrIn = Split(strIn, vbLf): sep = vbLf ' put the strinig in an array
            'start of modification__________________________________________
            If UBound(arrIn) < 1 Then arrIn = Split(strIn, vbCr): sep = vbCr
            If UBound(arrIn) < 1 Then arrIn = Split(strIn, vbCrLf): sep = vbCr
            Debug.Print "Sep: " & Len(sep), Asc(sep) ' adapted here...
            'end of modification____________________________________________

            For i = 1 To UBound(arrIn) ' build the string which excepts first row
                If arrIn(i) <> vbLf Then strExt = strExt & arrIn(i)
            Next i

            If finStr = "" Then 'Build the final string to be loaded in Master CSV
                finStr = strExt
            Else
                finStr = finStr & strExt
            End If
        'End If
        strExt = ""
        fullFilename = Dir  'reinitialize the loop
    Loop

    If finStr = "" Then Exit Sub 'happening in case of no csv files found in the folder
    Open masterFullName For Output As #1
        Print #1, finStr 'dropping the string in the master csv file
    Close #1
    'Opening the master file in Excel:
    Workbooks.OpenText fileName:=masterFullName, origin:=xlWindows, StartRow _
                :=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
                ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, _
                Space:=False, Other:=False
    'Save csv file As Excel xlsx format:
    Set wb = ActiveWorkbook
    wb.SaveAs fileName:=xlsFullName, FileFormat:=xlOpenXMLWorkbook
    Kill masterFullName
    MsgBox "MasterCSV Excel file saved as " & xlsFullName
End Sub
Private Function GetFolderPath(Optional strPath As String) As String
Dim fldr As FileDialog, sItem As String

 Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
 With fldr
    .buttonName = "Select Folder"
    .Title = "Select .CSV files to be processed Folder"
    .AllowMultiSelect = False
    If strPath <> "" Then .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
 End With
NextCode:
 GetFolderPath = sItem
 Set fldr = Nothing
End Function
...