Экспорт таблиц в CSV изменения файла с расширением - PullRequest
Новая
       10

Экспорт таблиц в CSV изменения файла с расширением

0 голосов
/ 29 октября 2019

Я пытаюсь экспортировать все свои таблицы из базы данных доступа в отдельные CSV-файлы. У меня есть цикл, который проходит через все таблицы и с помощью TransferText я хочу создать .csv-файл для каждой таблицы.

Я могу создать отдельный файл, написав метод TransferText. 

DoCmd.TransferText acExportDelim, "ExportCsv", [Table name], filePath + "Test.csv", True

Но когда я пытаюсь создать цикл для создания файла для каждой таблицы, у меня возникают проблемы,(Filepath установлен на рабочий стол) 

' Loops through all tables and extracts them as .csv-files    
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Set db = CurrentDb
For Each tdf In db.TableDefs
    ' ignore system and temporary tables
    If Not (tdf.Name Like "MSys*" Or tdf.Name Like "~*") Then
        ' Export table as CSV
        'MsgBox (tdf.Name)
        fileName = tdf.Name & ".csv"
        DoCmd.TransferText acExportDelim, "ExportCsv", tdf.Name, filePath + fileName, True

    End If
Next
Set tdf = Nothing
Set db = Nothing

При таком выполнении появляется ошибка «3011», говорящая о том, что не удается найти объект. Затем он дает мне имя объекта: [имя таблицы] #csv. Поэтому по какой-то причине он меняет «.csv» на «#csv».

Если я удаляю расширение файла из имени файла, все, что я получаю, это Ошибка 3027, говорящая, что объект или база данных доступны только для чтения.

Кто-нибудь знает, есть ли решение моей проблемы или другой способ сделать то же самое? Или мне придется пойти совсем другим путем?

РЕДАКТИРОВАТЬ:

Другие проверенные варианты 

DoCmd.TransferText acExportDelim, "ExportCsv", tdf.Name, "C:/tempFile.csv", True 
DoCmd.TransferText acExportDelim, "ExportCsv", tdf.Name, "C:/" & tdf.Name & ".csv", True

: выдает ошибку "#csv". 

DoCmd.TransferText acExportDelim, "ExportCsv", tdf.Name, "C:/tempFile", True
DoCmd.TransferText acExportDelim, "ExportCsv", tdf.Name, "C:/" & tdf.Name, True

: выдает ошибку только для чтения

Ответы [ 2 ]

0 голосов
/ 07 ноября 2019

Итак, после многих проб и ошибок я нашел способ, который мне подходит.

С вдохновением @Gustav я начал создавать файлы .xls, которые по какой-то причине работают. А затем преобразовать эти файлы с помощью специального сценария в .csv-файлы. Затем я удаляю файлы .xls, оставляя только мои .csv-файлы.

Итак, мой цикл теперь выглядит так: 

For Each tdf In db.TableDefs
    ' ignore system and temporary tables
    If Not (tdf.Name Like "MSys*" Or tdf.Name Like "~*") Then
        ' Export as xls-files
        fileName = tdf.Name & ".xls"
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, tdf.Name, filePath & env & fileName, True

        ' Convert xls-files to .csv and remove the xls-files.
        ConvertXls2CSV (filePath & env & fileName)
        VBA.Kill filePath & env & fileName
    End If
Next

А вот код преобразования: (Кредит: https://www.devhut.net/2012/05/14/ms-access-vba-convert-excel-xls-to-csv/)

Function ConvertXls2CSV(sXlsFile As String)
    On Error Resume Next
    Dim oExcel          As Object
    Dim oExcelWrkBk     As Object
    Dim bExcelOpened    As Boolean    'Was Excel already open or not
    'Review 'XlFileFormat Enumeration' for more formats
    Const xlCSVWindows = 23 'Windows CSV Format
    Const xlCSV = 6 'CSV
    Const xlCSVMac = 22 'Macintosh CSV
    Const xlCSVMSDOS = 24 'MSDOS CSV

    Set oExcel = GetObject(, "Excel.Application")    'Bind to existing instance of Excel

    If Err.Number <> 0 Then    'Could not get instance of Excel, so create a new one
        Err.Clear
        'On Error GoTo Error_Handler
        Set oExcel = CreateObject("excel.application")
        bExcelOpened = False
    Else    'Excel was already running
        bExcelOpened = True
    End If

    'On Error GoTo Error_Handler
    oExcel.ScreenUpdating = False
    oExcel.Visible = False   'Keep Excel hidden from the user
    oExcel.Application.DisplayAlerts = False

    Set oExcelWrkBk = oExcel.Workbooks.Open(sXlsFile)
    'Note: you may wish to change the file format constant for another type declared
    'above based on your usage/needs in the following line.
    oExcelWrkBk.SaveAs Left(sXlsFile, InStrRev(sXlsFile, ".")) & "csv", xlCSVWindows, Local:=True
    oExcelWrkBk.Close False

    If bExcelOpened = False Then
        oExcel.Quit
    End If

Error_Handler_Exit:
    On Error Resume Next
    Set oExcelWrkBk = Nothing
    Set oExcel = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: ConvertXls2CSV" & vbCrLf & _
            "Error Table: " & sXlsFile & vbCrLf & _
            "Error Description: " & Err.Description, _
            vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit

End Function
0 голосов
/ 29 октября 2019

Это известное ограничение. TransferText не любит извилистые имена файлов.

Итак, экспортируйте в простое имя файла, затем переименуйте этот файл в его окончательное имя: 

ExportFinal = "YourFinalName.csv"
ExportTemp = "FileToRename.csv"

DoCmd.TransferText acExportDelim, "ExportCsv", tdf.Name, ExportTemp, True

VBA.FileCopy ExportTemp, ExportFinal
VBA.Kill ExportTemp
...