我使用docmd.transfertext将CSV文件导入访问数据库。代码每隔一段时间就可以完美运行,但不知何故,我第一次运行它,第二次运行transfertext,我必须生成错误,然后再次运行它,那时它就可以了。可能是什么问题?
下面的代码 - docmd.transfertext语句位于CSVToAccess过程中。我已经指出了transfertext语句
的位置Public Sub Import(TickerID As String)
Call CSVToDesktop(TickerID)
Call CSVToAccess(TickerID)
Call FileCleanUp(TickerID)
Call RefreshTable
End Sub
Private Sub CSVToDesktop(TickerID As String)
'---------------------------------------------------------------------------------------'
' Downloads CSV file containing historical prices from Yahoo Finance ( not through YQL )
'---------------------------------------------------------------------------------------'
' General Variables---------'
Dim FixTickerID As String: FixTickerID = Replace(TickerID, "-", ".") ' Replaces - with . in Ticker name
Dim SplitTicker() As String: SplitTicker = Split(FixTickerID, ".") ' Splits the ticker name into only Ticker
Dim xPath As String: xPath = ThisWorkbook.Path & "\" & SplitTicker(0) & Date & ".csv" ' Universal store path
'--------------------------'
'Timeparameter = Download everything there is :D
StartMonth = 1: StartNumberofMonth = 1: StartYear = 1980
EndMonth = Month(Date) + 1: EndNumberOfMonth = Day(Date): EndYear = Year(Date)
' Specific structure of CSV file download
Dim URLString As String
URLString = "http://ichart.finance.yahoo.com/table.csv?s=" & TickerID & "&a=" & StartMonth - 1 & "&b=" & StartNumberofMonth & "&c=" & StartYear & _
"&d=" & EndMonth - 1 & "&e=" & EndNumberOfMonth & "&f=" & EndYear & "&g=d&ignore=.csv"
' HTTP Request: CSV-file url
Dim HTTPReq As XMLHTTP60: Set HTTPReq = New XMLHTTP60
HTTPReq.Open "Get", URLString, False
HTTPReq.send
Do Until HTTPReq.readyState = 4
DoEvents
Loop
' Import directly to Access Database which then delimits and adds primary keys to the data _
' no need to save the File on the computer in this case ( postponed to future versions )
Dim ADOBStream As ADODB.Stream: Set ADOBStream = New ADODB.Stream
With ADOBStream
.Open
.Type = adTypeBinary
.Write HTTPReq.responseBody ' HTTP CSV-file response into ADODBStream
.SaveToFile (xPath)
.Close
End With
' End of procedure: Cleanup
Set HTTPReq = Nothing
Set ADOBStream = Nothing
End Sub
Private Sub CSVToAccess(TickerID As String)
'---------------------------------------------------------------------------------------'
' Import AutoDownloaded CSV file to new table named after ticker name
' Index columns Date and Close
'---------------------------------------------------------------------------------------'
' General variables---------'
Dim FixTickerID As String: FixTickerID = Replace(TickerID, "-", ".") ' Replaces - with . in Ticker name
Dim SplitTicker() As String: SplitTicker = Split(FixTickerID, ".") ' Splits the ticker name into only Ticker
Dim xPath As String: xPath = ThisWorkbook.Path & "\" & SplitTicker(0) & Date & ".csv" '
'---------------------------'
' Import CSV-file in delimited format to relevant Access Database
Dim AccessObj As Access.Application: Set AccessObj = New Access.Application
' AccessObj.UserControl = True ' Hides/Displays the Access window
AccessObj.OpenCurrentDatabase "C:\Users\name\Desktop\Database.accdb" '!Create Procedure to choose database
DoCmd.TransferText acImportDelim, , SplitTicker(0), xPath, True **< --- TRANSFERTEXT STATEMENT**
CurrentDb.Execute "CREATE INDEX idxDateID ON " & SplitTicker(0) _
& "([Date] DESC) WITH PRIMARY;" ' Date = Primary Key, Descending format
' Add TickerID to stock table and check if stock(instrument) table is created
If IsNull(DLookup("Name", "MSysObjects", "Name='Instruments' and type in (1,4,6)")) Then
CurrentDb.Execute "CREATE TABLE Instruments (ID string);"
CurrentDb.Execute "INSERT INTO Instruments VALUES ('" & TickerID & "')"
Else
CurrentDb.Execute "INSERT INTO Instruments VALUES ('" & TickerID & "')"
End If
'Cleanup
DoCmd.Close
AccessObj.CloseCurrentDatabase
Set AccessObj = Nothing
End Sub
Private Sub FileCleanUp(TickerID As String)
'---------------------------------------------------------------------------------------'
' FileSystemObject reference: Microsoft Scripting Runtime
' Finds the saved CSV-file and deletes it
'---------------------------------------------------------------------------------------'
' General variables---------'
Dim SplitTicker() As String: SplitTicker = Split(TickerID, ".")
Dim xPath As String: xPath = ThisWorkbook.Path & "\" & SplitTicker(0) & Date & ".csv"
'---------------------------'
With New FileSystemObject
If .FileExists(xPath) Then
.DeleteFile xPath
End If
End With
End Sub
Private Sub RefreshTable()
' General Variables---------'
Dim CombBox As ComboBox: Set CombBox = Sheets("mainwindow").OLEObjects("combbox_instruments").Object
Dim TxtBox As Object: Set TxtBox = Sheets("mainwindow").OLEObjects("txtbox_import").Object
Dim FixTickerID As String: FixTickerID = Replace(TxtBox.Text, "-", ".") ' Replaces - with . in Ticker name
Dim SplitTicker() As String: SplitTicker = Split(FixTickerID, ".") ' Splits the ticker name into only Ticker
'---------------------------'
For Index = 0 To CombBox.ListCount - 1
If CombBox.List(Index) = SplitTicker(0) Then
Exit Sub
End If
Next Index
CombBox.AddItem SplitTicker(0)
End Sub