How do I retrieve data from an Excel Workbook without opening in VBA?
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! Thanks in advance, Laura
No comments:
Post a Comment