Chase
Chase

Reputation: 5

Formatting data imported from csv files to excel spreadsheet

I'm working on writing a script that will import the csv file outputs from a scanning electron microscope to a master spreadsheet organized by date and sample number. Having never used vba before and with little programming experience before now, this has been quite a challenge. There are a few thousand files organized by sample and image number. Right now what I have is able to read in the csv files and copy them to a single spreadsheet. The csv files look something like this

Atomic number,Element symbol,Element name,Concentration percentage,Certainty
8,O,Oxygen,57.5,0.99
14,Si,Silicon,15.5,0.99
26,Fe,Iron,13.6,0.97
13,Al,Aluminium,8.4,0.98
19,K,Potassium,3.3,0.97
22,Ti,Titanium,0.9,0.89
65,Tb,Terbium,0.7,0.53

When I run the code I have, the above data is copied from each file and pasted into the master spreadsheet. What I would like to do is have it format this data. Here is what I have so far to actually write the data to a spreadsheet.

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
    If IsMissing(WindowState) Then WindowState = 1
    hProg = Shell(PathName, WindowState)
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
    Do
        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

    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"

    DefPath = Application.DefaultFilePath
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If

    If Val(Application.Version) < 12 Then
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        FileExtStr = ".xlsx": FileFormatNum = 51
        'FileExtStr = ".xls": FileFormatNum = 56
    End If

    XLSFileName = DefPath & "SEM Master File" & _
                  Format(Now, "dd-mmm-yyyy h-mm-ss") & FileExtStr

    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

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

        ShellAndWait BatFileName, 0
        If Dir(TXTFileName) = "" Then
            MsgBox "There are no csv files in this folder"
            Kill BatFileName
            Exit Sub
        End If

        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, AdjustColumnWidth = True

        Set Wb = ActiveWorkbook
        Application.DisplayAlerts = False
        Wb.SaveAs Filename:=XLSFileName, FileFormat:=FileFormatNum
        Application.DisplayAlerts = True

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

        Kill BatFileName
        Kill TXTFileName

        Application.ScreenUpdating = True
    End If
End Sub

The name of each file is its sample/image number and date. What I need is for this to ignore the first row of data in each csv file (Atomic number,Element symbol, etc.), create a single protected row at the top of the sheet that has those labels, and record the name of each file in a column next to each row of data from that file. With this information recorded I think I will be able to organize the data the way I want.

Upvotes: 0

Views: 104

Answers (1)

Ryan Wildry
Ryan Wildry

Reputation: 5677

check out this approach using ADO. Adapted from: https://msdn.microsoft.com/en-us/library/ms974559.aspx

Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H0001

Set objConnection = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")

strPathtoTextFile = "C:\Databases\"

objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & strPathtoTextFile & ";" & _
      "Extended Properties=""text;HDR=YES;FMT=Delimited"""

objRecordset.Open "SELECT * FROM MyCSV.csv where [Atomic number] <> "Atomic number"", _
      objConnection, adOpenStatic, adLockOptimistic, adCmdText

Range("A2").CopyFromRecordset objRecordset
objRecordset.close
objConnection.close

Upvotes: 0

Related Questions