从Access VBA将.xlsx保存到.csv或.txt

4 回答

• 0

  如果您想扩展您的想法并将数据库中的所有对象导出到文本文件，请运行下面的脚本 .

  Private Sub Command4_Click()
  
  
  On Error GoTo Err_ExportDatabaseObjects
  
      Dim db As Database
      'Dim db As DAO.Database
      Dim td As TableDef
      Dim d As Document
      Dim c As Container
      Dim i As Integer
      Dim sExportLocation As String
  
      Set db = CurrentDb()
  
      sExportLocation = "C:\Users\rs17746\Desktop\Text_Files\" 'Do not forget the closing back slash! ie: C:\Temp\
  
      For Each td In db.TableDefs 'Tables
          If Left(td.Name, 4) <> "MSys" Then
              DoCmd.TransferText acExportDelim, , td.Name, sExportLocation & "Table_" & td.Name & ".txt", True
          End If
      Next td
  
      Set c = db.Containers("Forms")
      For Each d In c.Documents
          Application.SaveAsText acForm, d.Name, sExportLocation & "Form_" & d.Name & ".txt"
      Next d
  
      Set c = db.Containers("Reports")
      For Each d In c.Documents
          Application.SaveAsText acReport, d.Name, sExportLocation & "Report_" & d.Name & ".txt"
      Next d
  
      Set c = db.Containers("Scripts")
      For Each d In c.Documents
          Application.SaveAsText acMacro, d.Name, sExportLocation & "Macro_" & d.Name & ".txt"
      Next d
  
      Set c = db.Containers("Modules")
      For Each d In c.Documents
          Application.SaveAsText acModule, d.Name, sExportLocation & "Module_" & d.Name & ".txt"
      Next d
  
      For i = 0 To db.QueryDefs.Count - 1
          Application.SaveAsText acQuery, db.QueryDefs(i).Name, sExportLocation & "Query_" & db.QueryDefs(i).Name & ".txt"
      Next i
  
      Set db = Nothing
      Set c = Nothing
  
      MsgBox "All database objects have been exported as a text file to " & sExportLocation, vbInformation
  
  Exit_ExportDatabaseObjects:
      Exit Sub
  
  Err_ExportDatabaseObjects:
      MsgBox Err.Number & " - " & Err.Description
      Resume Exit_ExportDatabaseObjects
  
  End Sub
  

  回复于 2024-04-29T15:15:09+08:00
• 0

  您可以根据需要调整这一行代码：

  xl2.ActiveWorkbook.SaveAs ThisWorkbook.Path & "/" & "name your file" & ".csv"
  

  xl2 =这是你保存的excel文件，所以用xlApp或你声明你的excel文件改变它

  回复于 2024-04-29T15:15:09+08:00
• 0

  好吧，你可以使用它来打印实际的SQL .

  Private Sub Command2_Click()
  
  Dim db As Database
  Dim qr As QueryDef
  
  Set db = CurrentDb
  
  For Each qr In db.QueryDefs
    TextOut (qr.Name)
    TextOut (qr.SQL)
    TextOut (String(100, "-"))
  Next
  
  End Sub
  
  Public Sub TextOut(OutputString As String)
  
      Dim fh As Long
  
      fh = FreeFile
      Open "C:\Users\rs17746\Desktop\Text_Files\sample.txt" For Append As fh
      Print #fh, OutputString
      Close fh
  
  End Sub
  

  回复于 2024-04-29T15:15:09+08:00
• 1

  这是您的另一个版本 . 这会将每个查询的结果导出到一个单独的文本文件中 .

  Private Sub Command0_Click()
  
  
  Dim qdf As QueryDef
  Dim strFileName As String
  For Each qdf In CurrentDb.QueryDefs
  If Left(qdf.Name, 1) <> "~" Then
  
  'you need to figure out TransferText command. Maybe
  'you won't be lazy and expect people to read it to
  'you and tutor you on how it works.
  strFileName = qdf.Name
  
  'Docmd.TransferText ....
  DoCmd.TransferText transferType:=acExportDelim, TableName:=strFileName, FileName:="C:\test\" & strFileName & ".txt", hasfieldnames:=True
  
  End If
  Next qdf
  MsgBox "Done"
  
  
  End Sub
  

  回复于 2024-04-29T15:15:09+08:00