How do I retrieve data from an Excel Workbook without opening in VBA?

Question

I have a folder, which is selectable by a user, which will contain 128 files. In my code, I open each document and copy the relevant data to my main workbook. All this is controlled through a userform. My problem is the time it takes to complete this process (about 50 seconds) - surely I can do it without opening the document at all?

This code is used to select the directory to search in:

Private Sub CBSearch_Click()
Dim Count1 As Integer

    ChDir "Directory"
    ChDrive "C"
    Count1 = 1

    inputname = Application.GetOpenFilename("data files (*.P_1),*.P_1")

    TBFolderPath.Text = CurDir()

End Sub

This Retrieves the files:

Private Sub CBRetrieve_Click()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim i As Integer
Dim StrLen As Integer
Dim Folder As String
Dim A As String
Dim ColRef As Integer

Open_Data.Hide

StrLen = Len(TBFolderPath) + 1
Folder = Mid(TBFolderPath, StrLen - 10, 10)

For i = 1 To 128
A = Right("000" & i, 3)
    If Dir(TBFolderPath + "\" + Folder + "-" + A + ".P_1") <> "" Then
        Workbooks.OpenText Filename:= _
            TBFolderPath + "\" + Folder + "-" + A + ".P_1" _
            , Origin:=xlMSDOS, StartRow:=31, DataType:=xlDelimited, TextQualifier:= _
            xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
            Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
            Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True

        Columns("B:B").Delete Shift:=xlToLeft
        Rows("2:2").Delete Shift:=xlUp

        Range(Range("A1:B1"), Range("A1:B1").End(xlDown)).Copy

        Windows("Document.xls").Activate

        ColRef = (2 * i) - 1

        Cells(15, ColRef).Select
        ActiveSheet.Paste

        Windows(Folder + "-" + A + ".P_1").Activate
        ActiveWindow.Close
    End If
Next i

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

TBFolderPath is the contents of a textbox in the userform, and is the location of the files.

Sorry my code is so messy!

EDIT: An example of the data is:

TA2000 PLOT DATA FILE
FileName: c:\file
Version: 3.01

PlotNumber: 1
TotalPoints: 982
FrIndex: 460
F1Index: 427
F2Index: 498
FaIndex: 513

Transducer Type: 8024-004-A9
Serial Number: 
Date: 09-Aug-2013
Operator: LSP
20-80kHz 
     Time: 10:51:35             
Clf pF:             

Range mS: 0.5               
Aut/Man: Auto               
Shunt pF:               
Shunt uH:               
Step size: 150 Hz               
Rate: Max               
Start: 1.0              
Stop: 150.0             



A---------B-------------C--------------D--------E

0---------0.003695---1.000078---0.2-----12  
0---------0.004018---1.150238---0.2-----12
.
.
.

Where I am interested in A and C. Data has about 1000 entries.

I am guessing the files you want to open are purely in text? In that case, instead of opening them in Excel, I would suggest opening them in background using Open(). Moreover, refrain from using Windows() and .Activate & .Select method. It will only slow the code down. Lastly, refrain from using .Copy & .Paste since it will also copy the formats using more memory which means slower speed — kpark, Aug 21 '13 at 13:54
They're .csv I believe... The sheet data itself isn't purely numerical, but it could be if necessary. How would I do it without activating? — Laury93, Aug 21 '13 at 13:58
Right now, the Excel is parsing the files and then outputting them onto the sheet although you don't see it happening. You would need to create a function to parse the data yourself. By the way, there seems to be more code than there appears to be. What is `open_data`? [Take a look at this](http://stackoverflow.com/questions/10434335/text-file-in-vba-open-find-replace-saveas-close-file) — kpark, Aug 21 '13 at 14:05
open_data is the name of the userform. What is a parsing function? Sorry - I'm new to vba! — Laury93, Aug 21 '13 at 14:11
No problem at all, what I mean by parsing function is for you to create your own algorithm/code to separate the data from whatever is in the file. So, we know that .csv is delimited by semicolon and a new record is delimited by an "enter." We need to create a way of making our own function to do `.OpenText w/ many many options` if you have a general example of the file you are trying to read, I could probably help you write the parsing function. — kpark, Aug 21 '13 at 14:17

score 1 · Accepted Answer · answered Aug 21 '13 at 14:19

I use something similar to this to cycle through Excel files in a folder and use ADODB to read the contents.

Option Explicit

Private Sub ReadXL_ADODB()
Dim cnn1 As New ADODB.Connection
Dim rst1 As New ADODB.Recordset
Dim arrData() As Variant
Dim arrFields() As Variant
Dim EndofPath As String
Dim fs, f, f1, fc, s, filePath
Dim field As Long
Dim lngCount As Long
Dim filescount As Long
Dim wSheet As Worksheet
Dim lstRow As Long

    Set wSheet = Sheet1 'Set sheet to import data to

    With Application.FileDialog(msoFileDialogOpen)
            .AllowMultiSelect = True
            .Show

        For lngCount = 1 To .SelectedItems.Count
            EndofPath = InStrRev(.SelectedItems(lngCount), "\")
            filePath = Left(.SelectedItems(lngCount), EndofPath)
        Next lngCount

    End With

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(filePath)
    Set fc = f.Files
    filescount = 0

    For Each f1 In fc
        DoEvents
        'Open the connection to Excel then open the recordset
        cnn1.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & CStr(f1) & ";" & _
        "Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
        'Imports from sheet named xDatabase and range A:EF
        rst1.Open "SELECT * FROM [xDatabase$A:EF];", cnn1, adOpenStatic, adLockReadOnly

        'If target fields are empty write field names
        If WorksheetFunction.CountA(wSheet.Range("1:1")) = 0 Then
            For field = 0 To rst1.Fields.Count - 1
                wSheet.Range("A1").Offset(0, field).Value = rst1.Fields(field).Name
            Next field
        End If
        arrData = rst1.GetRows

        rst1.Close
        cnn1.Close
        Set rst1 = Nothing
        Set cnn1 = Nothing

        'Transpose array for writing to Excel
        arrData = TransposeDim(arrData)

        lstRow = LastRow(wSheet.Range("A:EF"))
        wSheet.Range("A1").Offset(lstRow, 0).Resize(UBound(arrData, 1) + 1, UBound(arrData, 2) + 1).Value = arrData
        filescount = filescount + 1
        Application.StatusBar = "Imported file " & filescount & " of " & fc.Count
    Next f1

Application.StatusBar = False
End Sub

Function TransposeDim(v As Variant) As Variant
' Custom Function to Transpose a 0-based array (v)

    Dim X As Long, Y As Long, Xupper As Long, Yupper As Long
    Dim tempArray As Variant

    Xupper = UBound(v, 2)
    Yupper = UBound(v, 1)

    ReDim tempArray(Xupper, Yupper)
    For X = 0 To Xupper
        For Y = 0 To Yupper
            tempArray(X, Y) = v(Y, X)
        Next Y
    Next X

    TransposeDim = tempArray

End Function

Public Function LastRow(ByVal rng As Range) As Long
'The most accurate method to return last used row in a range.
On Error GoTo blankSheetError
    'Identify next blank row
    LastRow = rng.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row

    'On Error GoTo 0 'not really needed
    Exit Function

blankSheetError:
    LastRow = 2 'Will produce error if blank sheet so default to row 2 as cannot have row 0
    Resume Next

End Function

You'll need to add a reference to the `Microsoft ActiveX Data Objects x.Y Library`. Also, as you're importing CSV's you'll need to change the Extended Properties to read TXT files instead of Excel - eg `"Extended Properties=""text; HDR=Yes; FMT=Delimited; IMEX=1;"""` and change the SQL statement. — , Aug 21 '13 at 14:57
Yeah, I've been looking at the SQL statement just now. Is it likely that that would be restricted to admins? — Laury93, Aug 21 '13 at 15:25
SQL is just a language so is not likely to be restricted. As long as you can access the folder and are able to enable macros on Excel then it should work. If you were trying to access a database then yes it could be restricted and may need login credenetials but in this case SQL is being used to read text files and not a database. — , Aug 21 '13 at 17:07

score 0 · Answer 2 · answered Aug 22 '13 at 13:26

I struggled with SQL, but I found a way to improve the efficiency of the code below. Thank you, both of you for your help and suggestions.

My new code is as follows:

Private Sub CBSearch_Click()

    ChDir "File Path"
    ChDrive "C"

    inputname = Application.GetOpenFilename("data files (*.P_1),*.P_1")

    TBFolderPath.Text = CurDir()

End Sub

And for retrieveing the data:

Private Sub CBRetrieve_Click()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim Element As Integer
Dim I As Long
Dim StrLen As Integer
Dim Folder As String
Dim A As String
Dim ColRef As Integer
Dim FileToOpen As Variant
Dim myString As String, X, j As Integer, k As Integer

Open_Data.Hide

StrLen = Len(TBFolderPath) + 1
Folder = Mid(TBFolderPath, StrLen - 10, 10)

For Element = 1 To 128
A = Right("000" & Element, 3)
    If Dir(TBFolderPath + "\" + Folder + "-" + A + ".P_1") <> "" Then

        FileToOpen = TBFolderPath & "\" & Folder & "-" & A & ".P_1"

        Reset
        Open FileToOpen For Input As #1
        I = 0
        Do While Not EOF(1)
            Input #1, myString
            If IsNumeric(Mid(myString, 1, 1)) = True And _
                IsNumeric(Mid(myString, 2, 1)) = False Then
            X = Split(myString, vbTab)
            I = I + 1

            Sheet1.Cells(I + 15, (2 * Element) - 1).Value = X(0)
            Sheet1.Cells(I + 15, (2 * Element)).Value = X(2)

            End If
        Loop
        Close #1

    End If
Next Element

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

The IsNumeric phrases are quite messy, but I needed to trim the first few lines off, all but one being text, and that one being 20-80.

Cheers,

Laura

How do I retrieve data from an Excel Workbook without opening in VBA?

2 Answers2