Макрос на Visual Basic for Application (VBA) чтения текстового файла в Access

Макрос на VBA под Access читает csv файл, парсирует его и записывает данные в таблицу. Конкретно макрос читает финансовые новости с http://www.dailyfx.com/calendar/ , разбирает по точке с запятой и записывает значения макроиндикаторов в таблицу.

' 2.07.09

Option Compare Database

' URL для загрузки http://www.dailyfx.com/calendar/

Public Date1, Time1, Time_Zone, Currency1, Desc, Impor, Actual, Forecast, Previus As String

Public sql, sql2 As String

Public rec, rec2 As Recordset

'Public CurrentDb As Database

Sub LoadIndicatorsData()

Dim sea As Integer ' счетчик новостей

Dim txtline As String

sea = 0

Open "E:\DT\Data\News_History\Calendar_3105_0506.csv" For Input As #1

Do While Not EOF(1)

zz = PublicToNull()

Line Input #1, txtline

If (Len(txtline) > 2) And (sea > 1) Then

zz = MakeData(txtline)

'If (InStr(LCase(Desc), "speak") > 0) Or (InStr(LCase(Desc), "introduction") > 0) Then

' zz = WriteToNews() ' если нашли чью-то речь, то пишем в ньюсы

'Else

zz = WriteToDB()

'End If

End If

sea = sea + 1

Loop

Close #1

End Sub

Function WriteToDB()

' записываем в БД

Dim myDate, myTime As Date

Dim pr As Integer

sql = "SELECT Indikator_ID FROM Indikators WHERE Indikator_name = '" + Trim(Desc) + "'"

Set rec = CurrentDb.OpenRecordset(sql, dbOpenDynaset)

If Not rec.EOF And Not rec.BOF Then

' если не нашли, ничего пока не делаем. Вставляем ниже

Else ' добавляем индикатор в базу

' ищем страну с валютой Currency1

sql2 = "SELECT ID FROM Countries WHERE Currency = '" + Trim(Currency1) + "'"

Set rec2 = CurrentDb.OpenRecordset(sql2, dbOpenDynaset)

If Not rec2.EOF And Not rec2.BOF Then

pr = rec2.Fields("ID")

sql = "INSERT INTO Indikators (Indikator_name, Country, Strenght) VALUES ('" + Trim(Desc) + "', '" + Trim(pr) + "', '" + Trim(Impor) + "')"

CurrentDb.Execute sql ' вставляем индикатор

Else ' не нашли страну с такой валютой

sql = "INSERT INTO Indikators (Indikator_name, Strenght) VALUES ('" + Trim(Desc) + "', '" + Trim(Desc) + "')"

CurrentDb.Execute sql ' вставляем индикатор, но без страны

End If

' теперь индикатор должен точно быть в таблице

Date1 = CreateDate(Date1) ' переделываем дату

myDate = CDate(Date1)

If Time1 <> Empty Then

myTime = CDate(Trim(Time1))

End If

sql = "SELECT Indikator_ID FROM Indikators WHERE Indikator_name = '" + Trim(Desc) + "'"

Set rec = CurrentDb.OpenRecordset(sql, dbOpenDynaset)

If Not rec.EOF And Not rec.BOF Then

rec.MoveFirst

pr = rec.Fields("Indikator_ID")

' запрос на вставление в History

sql2 = "INSERT INTO History (Indikator, His_date, His_time, Actual, Forecast, Previus)" _

& " VALUES ('" + Trim(pr) + "','" + Trim(CStr(myDate)) + "','" + Trim(CStr(myTime)) + "'," _

& "'" + Trim(CStr(Actual)) + "','" + Trim(CStr(Forecast)) + "','" + Trim(CStr(Previus)) + "')"

CurrentDb.Execute sql2

'rec.MoveNext

End If

WriteToDB = 0

End Function

Function PublicToNull()

' обнуляем переменные в которые считаваются данные

Date1 = ""

Time1 = ""

Time_Zone = ""

Currency1 = ""

Desc = ""

Impor = ""

Actual = ""

Forecast = ""

Previus = ""

PublicToNull = 0

End Function

Function CreateDate(a As Variant)

' функция переделывания даты из формата "Sat Jun 17" в "19.06.2009"

Dim st, mec, chislo As String

Dim m, c As String

Dim tmp As Integer

st = Trim(Right(a, Len(a) - 4))

mec = Left(st, 3)

If mec = "Jan" Then

m = "01"

ElseIf mec = "Feb" Then

m = "02"

ElseIf mec = "Mar" Then

m = "03"

ElseIf mec = "Apr" Then

m = "04"

ElseIf mec = "May" Then

m = "05"

ElseIf mec = "Jun" Then

m = "06"

ElseIf mec = "Jul" Then

m = "07"

ElseIf mec = "Aug" Then

m = "08"

ElseIf mec = "Sep" Then

m = "09"

ElseIf mec = "Okt" Then

m = "10"

ElseIf mec = "Nov" Then

m = "11"

ElseIf mec = "Dec" Then

m = "12"

Else

m = "01"

End If

chislo = Right(st, 2)

tmp = CInt(chislo)

If tmp < 10 Then ' если число меньше 10, то есть один знак, то добавляем впереди нолик

c = "0" + CStr(tmp)

Else

c = chislo

End If

CreateDate = c + "." + m + ".2009"

End Function

Function MakeData(txt As String)

' делаем из считываемой строки данные по глабольным переменным: дата,валюта, значения...

Dim str As String

If Len(txt) > 0 Then

' поочередно пихаем в публичные переменные (пусть не красиво, зато действено)

p = InStr(txt, ",")

Date1 = Trim(Left(txt, p - 1))

str = Right(txt, Len(txt) - p)

p = InStr(str, ",")

Time1 = Trim(Left(str, p - 1))

str = Right(str, Len(str) - p)

p = InStr(str, ",")

Time_Zone = Trim(Left(str, p - 1))

str = Right(str, Len(str) - p)

p = InStr(str, ",")

Currency1 = Trim(Left(str, p - 1))

str = Right(str, Len(str) - p)

p = InStr(str, ",")

Desc = Trim(Left(str, p - 1))

Desc = Replace(Desc, "'", "")

Desc = TrimMonth() ' если в конце вставлен месяц вида (JUN), то обрезаем

str = Right(str, Len(str) - p)

p = InStr(str, ",")

Impor = Trim(Left(str, p - 1))

str = Right(str, Len(str) - p)

p = InStr(str, ",")

Actual = Trim(Left(str, p - 1))

str = Right(str, Len(str) - p)

p = InStr(str, ",")

Forecast = Trim(Left(str, p - 1))

str = Right(str, Len(str) - p)

p = InStr(str, ",")

Previus = Trim(str)

End If

MakeData = 0

End Function

Function WriteToNews()

Dim myDate, myTime As Date

Date1 = CreateDate(Date1) ' переделываем дату

myDate = CDate(Date1)

If Time1 <> Empty Then

myTime = CDate(Trim(Time1))

End If

Desc = Replace(Desc, "'", "") ' заменяем одинарную ковычку, с ней не проходит

sql = "INSERT INTO News (News_text, Data, News_text2) VALUES ('" + Trim(Desc) + "', '" + Trim(CStr(myDate)) + "', '" + Trim(CStr(myTime)) + "')"

'sql = "INSERT INTO News (News_text,Data) VALUES ('" + Trim(Desc) + "','" + Trim(CStr(myDate)) + "')"

'sql = "INSERT INTO News (News_text,Time) VALUES ('" + Trim(Desc) + "','" + Trim(CStr(myTime)) + "')"

CurrentDb.Execute sql ' вставляем индикатор

WriteToNews = 0

End Function

Function TrimMonth()

TrimMonth = Desc

If InStr(Desc, "(JAN)") > 0 Then