2016-06-07 52 views
0

我正在編寫一個腳本,它將從掃描電子顯微鏡導入csv文件輸出到由日期和樣本編號組織的主電子表格。以前從未使用過vba,而且之前幾乎沒有編程經驗,這是一個相當大的挑戰。有幾千個文件按樣本和圖片編號組織。現在我所擁有的能夠讀取csv文件並將它們複製到一個電子表格中。該CSV文件看起來像這樣格式化從csv文件導入Excel電子表格的數據

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 

當我運行我的代碼,上面的數據是從每個文件複製並粘貼到主電子表格。我想要做的是讓它格式化這些數據。這是我迄今爲止實際將數據寫入電子表格的內容。

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 

每個文件的名稱是其樣本/圖像號碼和日期。我需要的是忽略每個csv文件中的第一行數據(原子序號,元素符號等),在包含這些標籤的工作表頂部創建一個受保護的行,並記錄每個文件放在該文件每行數據旁邊的列中。記錄這些信息後,我認爲我可以按照自己想要的方式組織數據。

回答

0

使用ADO檢查此方法。改編自: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 
相關問題