Reputation: 5
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
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