Option Explicit
Sub test()
Dim fn As String, txt, x, y, myCols, a() As String, temp, i As Long, e, n
myCols = Array(0, 1, 3, 5, 6, 13, 16, 21, 23, 25, 27, 29, 30)
fn = Application.GetOpenFilename("All Files (*.CSV), *.CSV")
txt = CreateObject("Scripting.FilesystemObject").OpenTextFile(fn).ReadAll
x = Split(txt, vbCrLf)
ReDim a(1 To UBound(x) + 1, 1 To UBound(myCols) + 4)
For i = 1 To UBound(x)
If x(i) <> "" Then
y = Split(x(i), ";")
n = 0
For Each e In myCols
n = n + 1
Select Case e
Case 3
a(i, n) = Val(Replace(y(e), ",", "."))
Case 5
temp = GetBarCodes(y(e))
a(i, n) = temp(0)
n = n + 1
a(i, n) = temp(1)
Case 27
temp = GetTitles(y(e))
If IsArray(temp) Then
a(i, n) = temp(0)
n = n + 1
a(i, n) = temp(1)
n = n + 1
a(i, n) = temp(2)
Else
n = n + 2
End If
Case Else: a(i, n) = y(e)
End Select
Next
End If
Next
With Sheets(1).Cells(1)
.Resize(, 16).Value = Array("o:loi", "Annotation", "Price", "Barcode1", "Barcode2", "Invoice Number", _
"Library Location", "Charge Date", "Location Mark", "Catalogue Record", "Sigillum", _
"Title", "Author", "Publisher", "Genre", "Loan object class")
.Offset(1).Resize(UBound(a, 1), UBound(a, 2)).Value = a
End With
End Sub
Function GetBarCodes(ByVal txt As String)
Dim m As Object, temp1 As String, temp2 As String
Static RegX As Object
If RegX Is Nothing Then Set RegX = CreateObject("VBScript.RegExp")
With RegX
.Global = True
.Pattern = "((361|C)\d+)"
If .test(txt) Then
For Each m In .Execute(txt)
If m.Value Like "C*" Then
temp2 = m.Value
Else
temp1 = m.Value
End If
Next
End If
GetBarCodes = VBA.Array(temp1, temp2)
End With
End Function
Function GetTitles(ByVal txt As String)
Static RegX As Object
If RegX Is Nothing Then Set RegX = CreateObject("VBScript.RegExp")
With RegX
.Pattern = "([^/.*]+)(?:/)?([^\*]+)?\*{2}([^\*]+)"
If .test(txt) Then
GetTitles = VBA.Array(.Execute(txt)(0).submatches(0), .Execute(txt)(0).submatches(1), .Execute(txt)(0).submatches(2))
End If
End With
End Function
Bookmarks