Option Explicit
Sub GPE()
Dim cnn As Object, rst As Object, regx As Object
Dim sFilename As String, Arr(), Arrresult(), i As Long, tmp$
sFilename = Application.GetOpenFilename()
If sFilename <> "False" Then
Set cnn = CreateObject("ADODB.connection")
Set rst = CreateObject("ADODB.recordset")
With cnn
.provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Data source") = sFilename
.Properties("Extended properties") = "Excel 12.0;HDR=NO;IMEX=1"
.Open
End With
rst.Open "SELECT f8,f3 FROM [Data (1)$A4:H65536]", cnn, 3, 3, 1
Arr = TransArr(rst.getrows): ReDim Arrresult(0 To UBound(Arr, 1), 0 To 3)
'--------------------------------------------------------------------------------
Set regx = CreateObject("VBscript.regexp")
regx.Pattern = "SYSTEMID=(.+):-:RACKID=\d+:-:SELFID=\d+:-:SLOT=(\d+):-:PORT=(\d+):-:"
For i = 0 To UBound(Arr, 1)
Arrresult(i, 3) = Arr(i, 1)
tmp = Arr(i, 0)
With regx.Execute(tmp)(0)
Arrresult(i, 0) = .submatches(0)
Arrresult(i, 1) = .submatches(1)
Arrresult(i, 2) = .submatches(2)
End With
Next
Range("C2").Resize(i + 1, 4) = Arrresult
'---------------------------------------------------------------------------------------
Set regx = Nothing
Set rst = Nothing
cnn.Close: Set cnn = Nothing
End If
End Sub
'============================================================
Function TransArr(sArr As Variant) As Variant
Dim cllX As Long, cllY As Long, tmpX As Long, tmpY As Long, tmparr As Variant
tmpX = UBound(sArr, 2): tmpY = UBound(sArr, 1)
ReDim tmparr(tmpX, tmpY)
For cllX = 0 To tmpX
For cllY = 0 To tmpY
tmparr(cllX, cllY) = sArr(cllY, cllX)
Next cllY
Next cllX
TransArr = tmparr
End Function
'SYSTEMID=NAN.HNN.HNN.L2S.FU14:-:RACKID=0:-:SELFID=0:-:SLOT=0:-:PORT=5:-:VPI=8:-:VCI=35
