Option Explicit
Sub importQuiz()
Dim lr&, i&, index1&, index2&, line&, textString As String, rng, FileToRead
Dim ws As Worksheet
Set ws = Worksheets(1)
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
Range("2:" & lr + 1).ClearContents
Dim objStream, strData
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
objStream.Open
objStream.LoadFromFile ("c:\temp\questions1-3.txt")
textString = objStream.ReadText()
Set objStream = Nothing
textString = Replace(textString, vbCrLf, "")
index1 = 1: index2 = 1
line = 2
index2 = InStr(index1, textString, "A.")
While (index2 > 0)
With ws
.Cells(line, 1) = Trim(Mid(textString, index1, index2 - index1))
index1 = index2 + 3
index2 = InStr(index1 + 1, textString, "B.")
.Cells(line, 5) = Trim(Mid(textString, index1, index2 - index1))
index1 = index2 + 3
index2 = InStr(index1 + 1, textString, "C.")
.Cells(line, 6) = Trim(Mid(textString, index1, index2 - index1))
index1 = index2 + 3
index2 = InStr(index1 + 1, textString, "D.")
.Cells(line, 7) = Trim(Mid(textString, index1, index2 - index1))
index1 = index2 + 3
index2 = InStr(index1 + 1, textString, "Answer:")
.Cells(line, 8) = Trim(Mid(textString, index1, index2 - index1))
.Cells(line, 4) = Asc(Mid(textString, index2 + 8, 1)) - Asc("A") + 1
.Cells(line, 2) = "Uncategorized"
index1 = index2 + 9
End With
index2 = InStr(index1 + 1, textString, "A.")
line = line + 1
Wend
Application.ScreenUpdating = True
MsgBox "Finish!"
End Sub
1. Change your file location.
Bookmarks