View Full Version : VBA importing data from .txt
allen4pyd
08-16-2013, 01:51 PM
Hi,
I've only recently began learning vba due to a new job. However I could do with some help with a macro that's to technical for me to write
Basically I have a few hundred .txt files in the format as follows:
13 January 2012 01:45:00 8.2100
13 January 2012 02:00:00 8.1500
13 January 2012 02:15:00 8.1800
13 January 2012 02:30:00 8.1000
13 January 2012 02:45:00 8.1000
What I'd like to do is import ONLY the last number, line by line so it can be imported into a table...
Now, im not sure if this is possible but I would like it to loop through a selected folder file by file in the order they appear
Thanks for any help in advance :)
patel
08-17-2013, 12:00 AM
attach please a small sample result file and one text file
Kenneth Hobs
08-17-2013, 01:16 PM
That is not difficult but requires a few steps. How do you define the order of the files as they appear? Is it by file modified date, file created date, filename etc.?
Where would the data be inserted, next empty cell in Column A on the current sheet, etc.?
allen4pyd
08-18-2013, 03:10 AM
Kenneth Hobs
The files appear in order as their filename.
For example: "1 Filename", "2 Filename", "2 Filename (1)", "2 Filename (2), "3 Filename", "4 Filename"
Note there is more than one file under the name "2 filename", this occurs quite often throughout.
Yes, after the first file is inserted, the first line of the next file would ideally go on the next free line of that column
Thanks
Kenneth Hobs
08-18-2013, 02:23 PM
Change what you need in the first sub and run it. Note that numbers like 9.1000 will be added as 9.1. You can always set a numberformat if needed.
Sub insertTXTdata() Dim r As Range
Dim a() As Variant, vA As Variant
Dim b() As String
Dim c() As String, sC As String
Dim i As Integer
Dim sPath As String, sCol As String
sPath = ThisWorkbook.Path
sCol = "A"
Set r = Range(sCol & "1").End(xlUp).Offset(1)
a() = GetFileList(sPath & "\*.txt")
a() = SortArray(a)
For Each vA In a()
b() = Split(StrFromTXTFile(sPath & "\" & vA), vbCrLf)
For i = LBound(b) To UBound(b)
c() = Split(b(i))
r.Value = c(UBound(c))
'r.NumberFormat = "#.0000"
Set r = r.Offset(1)
Next i
Next vA
End Sub
Function StrFromTXTFile(filePath As String) As String
Dim str As String, hFile As Integer
If Dir(filePath) = "" Then
StrFromTXTFile = "NA"
Exit Function
End If
hFile = FreeFile
Open filePath For Binary Access Read As #hFile
str = Input(LOF(hFile), hFile)
Close hFile
StrFromTXTFile = str
End Function
Function GetFileList(FileSpec As String) As Variant
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False
Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
On Error GoTo NoFilesFound
FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound
' Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function
' Error handler
NoFilesFound:
GetFileList = False
End Function
Public Function SortArray(ByRef MyArray As Variant, Optional Order As Long = xlAscending) As Variant
Dim w As Worksheet
Dim r As Range
Set w = ThisWorkbook.Worksheets.Add()
On Error Resume Next
Range("A1").Resize(UBound(MyArray, 1), 1) = WorksheetFunction.Transpose(MyArray)
Range("A1").Resize(UBound(MyArray, 1), UBound(MyArray, 2)) = WorksheetFunction.Transpose(MyArray)
Set r = w.UsedRange
If Order = xlAscending Then
r.Sort Key1:=r.Cells(1, 1), Order1:=xlAscending
Else
r.Sort Key1:=r.Cells(1, 1), Order1:=xlDescending
End If
SortArray = r
Set r = Nothing
Application.DisplayAlerts = False
w.Delete
Application.DisplayAlerts = True
Set w = Nothing
End Function
I'd try:
Sub M_snb()
c00 = "G:\OF\*.txt"
For Each it In Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & c00 & """ /b").stdout.readall, vbCrLf)
c01 = c01 & vbLf & Join(Filter(Split(Replace(CreateObject("scripting.filesystemobject").opentextfile(it).readall, vbCrLf, ",")), "."), vblf)
Next
sn = Split(Mid(c01, 2), vbLf)
Sheets("sheet1").Cells(1).Resize(UBound(sn) + 1) = Application.Transpose(sn)
End Sub
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.