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

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

TrimMonth = Trim(Left(Desc, Len(Desc) - 5))

Exit Function

End If

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

TrimMonth = Trim(Left(Desc, Len(Desc) - 5))

Exit Function

End If

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

TrimMonth = Trim(Left(Desc, Len(Desc) - 5))

Exit Function

End If

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

TrimMonth = Trim(Left(Desc, Len(Desc) - 5))

Exit Function

End If

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

TrimMonth = Trim(Left(Desc, Len(Desc) - 5))

Exit Function

End If

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

TrimMonth = Trim(Left(Desc, Len(Desc) - 5))

Exit Function

End If

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

TrimMonth = Trim(Left(Desc, Len(Desc) - 5))

Exit Function

End If

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

TrimMonth = Trim(Left(Desc, Len(Desc) - 5))

Exit Function

End If

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

TrimMonth = Trim(Left(Desc, Len(Desc) - 5))

Exit Function

End If

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

TrimMonth = Trim(Left(Desc, Len(Desc) - 5))

Exit Function

End If

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

TrimMonth = Trim(Left(Desc, Len(Desc) - 5))

Exit Function

End If

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

TrimMonth = Trim(Left(Desc, Len(Desc) - 5))

Exit Function

End If

End Function

( VBA)
VBA Excel Access
VBA RSS- Access
VBA Access
Visio Access
Power Point
()



@Mail.ru

 
 
:
VBA -2014
, E-mail: apsheronka@mail.ru
,


http://apsheronsk.bozo.ru - !

polar rs800cx n bike . Garmin nuvi 1310 .