如何将文件另存为以“原始文件名＋年月日时分秒”的方式保存为不同文件名

LZJDTQ

因为每天提取不同的数据，需用宏的方式首先将数据分列，再将文件另存为以“原始文件名＋年月日时分秒”的方式保存为不同文件名另存，在重命名时被难住，谢谢论坛的老师给以指导！

风筝那根线

更新下
Sub 另存为2()
    Dim strFilePath$
    Dim fname$, i%

    fname = ThisWorkbook.Name
    fname = Left(fname, InStrRev(fname, ".") - 1)
    fname = fname & " " & Format(Now, "yyyy年m月d日 h时m分s秒") & ".csv"
    fname = ThisWorkbook.Path & "\" & fname
    With Application.FileDialog(msoFileDialogSaveAs)
        For i = 1 To .Filters.Count
            If .Filters(i).Extensions = "*.csv" Then Exit For
        Next
        .FilterIndex = i
        .InitialFileName = fname
        If .Show = -1 Then
            strFilePath = .SelectedItems(1)
        Else
            MsgBox "已取消保存": Exit Sub
        End If
    End With
    ThisWorkbook.SaveAs strFilePath
End Sub

LZJDTQ

风筝那根线 发表于 2019-12-16 18:18

谢谢老师的分享，认真学习中！

风筝那根线

LZJDTQ 发表于 2019-12-17 00:13
谢谢老师的分享，认真学习中！

之前的有点问题，2楼更新了一下

LZJDTQ

请问老师 ，如果想以原文件名加时间另存应怎么改，谢谢！

wangqh8203

LZJDTQ 发表于 2019-12-17 10:47
请问老师 ，如果想以原文件名加时间另存应怎么改，谢谢！

Sub test()
'On Error Resume Next
Dim pt As String
pt = ThisWorkbook.Path
If (Right(pt, 1) = "\") Then
    pt = pt
Else
    pt = pt & "\"
End If

ThisWorkbook.SaveAs Filename:=pt & Split(ThisWorkbook.Name, ".")(0) & Application.Text(Now(), "yyyy-mm-dd hh mm ss"), FileFormat:=xlOpenXMLWorkbook '将工作簿另存为EXCEL默认格式
End Sub

LZJDTQ

wangqh8203 发表于 2019-12-17 11:44
Sub test()
'On Error Resume Next
Dim pt As String

老师，您看是怎么回事，谢谢！