Jump to content

Welcome to Geeks to Go - Register now for FREE

Need help with your computer or device? Want to learn new tech skills? You're in the right place!
Geeks to Go is a friendly community of tech experts who can solve any problem you have. Just create a free account and post your question. Our volunteers will reply quickly and guide you through the steps. Don't let tech troubles stop you. Join Geeks to Go now and get the support you need!

How it Works Create Account
Photo

VBA


  • Please log in to reply

#1
rclair

rclair

    New Member

  • Member
  • Pip
  • 1 posts
Hello there,

I have limited coding skills in VBA.
I have used extensive MS Visual Basic help to copy and paste some code and it seem to work with Excel files.

But I would like to move away from by converting .xls files to .csv files.
I have done that and it works.

Now I would like to know how I can select various data values from converted .csv files. I would then like to dump data in Access data base.

I have tried Mid, VBcompare, Trim functions together and it seems to work.
Is there another clean, efficient and easier way to do the this??

For example how would I select measured value 0.996 from row 21 that starts with words "static accuracy" ??

My code is below. To make it simple I have only posted code for one data element that I pikced.

I would certainly appreciate if someone can help.

I have also attached one of my .csv file.
*****************
Option Compare Database

Global MyDateCreated(10000), DU_SN(10000), TotalFiles, MyFiles(10000), MyLines(10000), i, k, HDUBitCompletionTime(10000)
Global HelmetBitCompletionTime(10000), AMRUBitCompletionTime(10000), StaticAccuracy1(10000), StaticAccuracy2(10000)
Global StaticAccuracy3(10000), StaticAccuracy4(10000), StaticAccuracy5(10000), StaticAccuracy6(10000), ImageReg1(10000)
Global ImageReg2(10000), ImageReg3(10000), ImageReg4(10000), HCAMAlign1(10000), HCAMAlign2(10000), FieldofView1(10000)
Global FieldofView2(10000), FieldofView3(10000)
Global FieldofView4(10000), FieldofView5(10000), FieldofView6(10000), Focus9(10000), Focus10(10000)
Global Focus1(10000), Focus2(10000), Focus3(10000), Focus4(10000), Focus5(10000), Focus6(10000), Focus7(10000), Focus8(10000)
Global LumMeasure1(10000), LumMeasure2(10000), DisplayUniformity1(10000), UniformityL1(10000), UniformityL2(10000), UniformityL3(10000)
Global UniformityL4(10000), UniformityL5(10000), UniformityL6(10000), UniformityL7(10000), UniformityL8(10000), UniformityL9(10000)
Global DisplayUniformity2(10000), UniformityR1(10000), UniformityR2(10000), UniformityR3(10000), UniformityR4(10000), UniformityR5(10000)
Global UniformityR6(10000), UniformityR7(10000), UniformityR8(10000), UniformityR9(10000), DisplayUniformity3(10000), DisplayUniformity4(10000)
Global DisplayUniformity5(10000), DisplayUniformity6(10000), DisplayUniformity7(10000), DisplayUniformity8(10000), DisplayUniformity9(10000)
Global DisplayUniformity10(10000), DisplayUniformity11(10000)

'*************************
Sub all()
i = 0
k = 0
j = 0
'TestDataFile = 0
XLStoCSV
'FileSearch
OpenFileAndReadIntoArray
DataDump_Access
End Sub

Sub XLStoCSV()

'Subroutine to convert EXCEL files to .CSV files
'Get the list of folders to read from
Set fs = CreateObject("Scripting.FileSystemObject")
Set rt = fs.GetFolder("C:\JHMCS_DU_Atp_Data\")
Dim i
'Ensure the folder to save to exists
Dim saveToFolder As String
saveToFolder = "C:\JHMCS_DU_Atp_Data\"

'If fs.FolderExists(saveToFolder) = False Then
'fs.CreateFolder saveToFolder
'End If
'j = 1
For Each folder In rt.SubFolders

'Find Excel files in the folders
For Each file In folder.Files
If Right(file.Name, 4) = ".xls" Then
'If (file.Name) = ".xls" Then

'Open .XLS file, save as .CSV file, & close.
Dim wrkBk As WorkBook
Set wrkBk = WorkBooks.Open(file.Path)

'Add .CSV extension to the file
Dim csvFileName As String
csvFileName = saveToFolder & Left(file.Name, Len(file.Name) - 4) & ".csv"
'csvFileName = saveToFolder & file.Name & ".csv"
'csvFileName = Left(file.Name, Len(file.Name) - 4) & ".csv"
'csvFileName = file.Name & ".csv"

'Create file array
i = i + 1
MyFiles(i) = csvFileName
Files = Files + 1

'Delete any previously created .CSV files.. path to file location necessary.
If fs.FileExists(csvFileName) Then
fs.DeleteFile csvFileName
End If

'save workbook as .CSV file
wrkBk.SaveAs csvFileName, xlCSV
wrkBk.Close False
End If
Next

Next
TotalFiles = Files
End Sub

'*************************

Sub CSVdata()
Dim fs, F ', FileObject, ts
Set fs = CreateObject("Scripting.FileSystemObject")

For i = 1 To TotalFiles 'counter for all files
On Error Resume Next
Set F = fs.GetFile(MyFiles(i))
MyDateCreated(i) = F.DateLastModified 'Get test run date

Set ts = F.OpenAsTextStream 'Opens file as .CSV.
ii = 1
Do While ts.atendofstream <> True
MyLines(ii) = ts.readline
ii = ii + 1
Loop

'** Begin data collection ****
'Get HDU S/N
kk = 1
Do
If InStr(1, MyLines(kk), "DU Serial Number", vbTextCompare) Then
DU_SN(i) = Mid(MyLines(kk), 19, 5)
End If
kk = kk + 1
Loop Until InStr(1, MyLines(kk - 1), "DU Serial Number", vbTextCompare) <> 0 Or kk > ii
Next i
'**********

Sub DataDump_Access()
Dim adoRecordset As ADODB.Recordset
Set adoRecordset = New ADODB.Recordset
adoRecordset.ActiveConnection = CurrentProject.Connection
adoRecordset.Open "Select * from [JSF DU Test Data]", , adOpenDynamic, adLockOptimistic

'i is the counter for total test files
For i = 1 To TotalFiles
adoRecordset.AddNew
adoRecordset("HDU_SN") = HDU_SN(i)
adoRecordset("DateCreated") = MyDateCreated(i)

adoRecordset.Update
Next i

adoRecordset.Update
End Sub
  • 0

Advertisements







Similar Topics

0 user(s) are reading this topic

0 members, 0 guests, 0 anonymous users

As Featured On:

Microsoft Yahoo BBC MSN PC Magazine Washington Post HP