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

问：

希望你一切安好。我还是个新手，所以请耐心等待我。

我正在尝试将 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

Excel VBA 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

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

Modify macro to eliminate dialog box and open newly created file

评论

评论