csv 修改宏以消除对话框并打开新创建的文件

ddhy6vgd  于 2023-09-27  发布在  其他
关注(0)|答案(2)|浏览(125)

希望你一切都好。我还是个新手,所以请对我有耐心。
我试图将Excel中的一个范围保存到单独的CSV文件中。我发现这段代码可以工作,但我想做2个修改。我对打开的要求我保存文件的对话框不感兴趣。如果它只是保存在当前文件夹中,那对我来说很好。另外,是否有一种方法可以在创建后自动打开新创建的CSV文件?
谢谢你
桑尼

Option Explicit
 
Public Sub ExcelRowsToCSV()
 
  Dim iPtr As Integer
  Dim sFileName As String
  Dim intFH As Integer
  Dim aRange As Range
  Dim iLastColumn As Integer
  Dim oCell As Range
  Dim iRec As Long
 
  Set aRange = Range("D1:V39")
  iLastColumn = aRange.Column + aRange.Columns.Count - 1
  
  iPtr = InStrRev(ActiveWorkbook.FullName, ".")
  sFileName = Left(ActiveWorkbook.FullName, iPtr - 1) & Format(Date, " mmm dd, yyyy ") & ".csv"
  sFileName = Application.GetSaveAsFilename(InitialFileName:=sFileName, FileFilter:="CSV (Comma delimited) (*.csv), *.csv")
  If sFileName = "False" Then Exit Sub
    
  Close
  intFH = FreeFile()
  Open sFileName For Output As intFH
  
  iRec = 0
  For Each oCell In aRange
    If oCell.Column = iLastColumn Then
      Print #intFH, oCell.Value
      iRec = iRec + 1
    Else
      Print #intFH, oCell.Value; ",";
    End If
  Next oCell
   
  Close intFH
  
  MsgBox "Finished: " & CStr(iRec) & " records written to " _
     & sFileName & Space(10), vbOKOnly + vbInformation
 
End Sub
xam8gpfp

xam8gpfp1#

创建一个新的工作簿,复制数据并保存为CSV而不是open/print csv。避免重新打开csv文件。

Option Explicit
Public Sub ExcelRowsToCSV()
    Dim iPtr As Integer
    Dim sFileName As String
    Dim aRange As Range
    Dim newWK As Workbook
    Set aRange = ActiveWorkbook.ActiveSheet.Range("D1:V39")
    iPtr = InStrRev(ActiveWorkbook.FullName, ".")
    sFileName = Left(ActiveWorkbook.FullName, iPtr - 1) & Format(Date, " mmm dd, yyyy ") & ".csv"
    Set newWK = Workbooks.Add
    With aRange
        newWK.ActiveSheet.Range("A1").Resize(.Rows.Count, .Columns.Count).Value = .Value
    End With
    newWK.SaveAs Filename:=sFileName, _
        FileFormat:=xlCSVUTF8, CreateBackup:=False
    MsgBox "Finished: " & CStr(aRange.Rows.Count) & " records written to " _
        & sFileName & Space(10), vbOKOnly + vbInformation
End Sub
fd3cxomn

fd3cxomn2#

sFileName = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.FullName, iPtr - 1) & _
            Format(Date, " mmm dd, yyyy ") & ".csv"

将保存到与ActiveWorkbook相同的文件夹中(前提是该工作簿已保存在某个位置)
Workbooks.Open(sFileName)将在excel中打开保存的文件。

相关问题