Option Explicit
Sub exa()
Dim REX As Object ' RegExp
Dim rexSM As Object ' SubMatches
Dim wks As Worksheet
Dim rngData As Range
Dim aryVals As Variant
Dim i As Long
Dim strConnection As String
Set wks = ThisWorkbook.Worksheets.Add
'// Change path to suit... //
strConnection = "TEXT;C:\Documents and Settings\MARK\Desktop\2011-08-03\2011-08-08\test.txt"
With wks
With .QueryTables.Add(Connection:=strConnection, Destination:=wks.Range("A1"))
.Name = "test"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 9, 1, 9)
.TextFileFixedColumnWidths = Array(19, 19, 12)
.Refresh BackgroundQuery:=False
.Delete
End With
Set rngData = Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 2)
aryVals = rngData.Value
Set REX = CreateObject("VBScript.RegExp")
REX.Global = True
'31.05.2011 16:30:00
REX.Pattern = "(\d{2})(\.)(\d{2})(\.)(\d{4})(\ {1,2})(\d{2})(\:)(\d{2})(\:)(\d{2})"
For i = 1 To UBound(aryVals, 1)
Set rexSM = REX.Execute(aryVals(i, 1))(0).SubMatches
aryVals(i, 1) = DateSerial(rexSM(4), rexSM(2), rexSM(0)) _
+ TimeSerial(rexSM(6), rexSM(8), rexSM(10))
Next
rngData.NumberFormat = "General"
rngData.Value = aryVals
rngData.Columns(1).NumberFormat = "dd/mm/yyyy hh:mm:ss"
rngData.Columns(2).NumberFormat = "#0.000"
End With
End Sub
