Dim AC As Object Set AC = CreateObject("ACCESS.APPLICATION") Db = ThisWorkbook.Path & "\test.accdb" If Dir(Db) <> "" Then Kill Db End If With AC .NEWCURRENTDATABASE Db .CloseCurrentDatabase End With Set AC = Nothing 方法二：利用VBA导入CSV数据到ACCESS数据库 Dim cnn As Object Dim myPath$, MyFile$, Sql$, s$ Set cnn = CreateObject("ADODB.Connection") cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\test.accdb" '连接数据库 myPath = ThisWorkbook.Path & "\" MyFile = Dir(myPath & "*.CSV") While MyFile <> "" s = "[" & MyFile & "]" & vbCrLf & "ColNameHeader = TRUE" & vbCrLf & "Format = CSVDelimited" & vbCrLf & "MaxScanRows=0" ‘’‘若表已经存在，如TEST，则直接导入如下： Sql = " INSERT INTO TEST SELECT DATE_ID,EUTRANCELLTDD AS CELL,InterferencePwrPusch AS PUSCH干扰,InterferencePwrPucch AS PUCCH干扰 FROM [TEXT;HDR=NO;FMT=Delimited;DATABASE=" & myPath & ";].[" & MyFile & "];" ’‘’若表不存在则先创建，TEST表，如下： Sql = " SELECT DATE_ID,EUTRANCELLTDD AS CELL,InterferencePwrPusch AS PUSCH干扰,InterferencePwrPucch AS PUCCH干扰 INTO TEST FROM [TEXT;HDR=NO;FMT=Delimited;DATABASE=" & myPath & ";].[" & MyFile & "];" Open myPath & "schema.ini" For Output As #1 Print #1, s Close #1 cnn.Execute Sql MyFile = Dir() cnn.Close Set cnn = Nothing Kill ThisWorkbook.Path & "\schema.ini" End Sub 方法一：利用VBA创建ACCESS数据库Sub CR_DB() Dim AC As Object Set AC = CreateObject("ACCESS.APPLICATION") Db = ThisWorkbook.Path & "\test.accdb" If Dir(Db) <> "" Then Kill Db End If With AC .NEWCURRE