Как получить имя файла в = диапазон ("b3") и сейчас ()
Так что в этой строке кода он делает все, что мне нужно, кроме правильного именования. Это откроет окно, которое спрашивает меня, где сохранить, но не вариант для имени, кроме того, я хотел бы сохранить как..
range("b3") & format(now(), ddmmyy)
Как я могу получить это, чтобы вписаться в это и правильно отформатировать?
Private Sub CommandButton1_Click()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range
Set xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
If xFileDlg.Show = True Then
xFolder = xFileDlg.SelectedItems(1)
Else
MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf
& "Press OK to exit this macro.", vbCritical, "Must Specify Destination
Folder"
Exit Sub
End If
xFolder = xFolder + "\" + xSht.Name + ".pdf"
'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do
you want to overwrite it?", _
vbYesNo + vbQuestion, "File Exists")
On Error Resume Next
If xYesorNo = vbYes Then
Kill xFolder
Else
MsgBox "if you don't overwrite the existing PDF, I can't continue." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.",
vbCritical, "Exiting Macro"
Exit Sub
End If
If Err.Number <> 0 Then
MsgBox "Unable to delete existing file. Please make sure the file is
not open or write protected." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.",
vbCritical, "Unable to Delete File"
Exit Sub
End If
End If
Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Save as PDF file
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder,
Quality:=xlQualityStandard
'Create Outlook email
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmailObj = xOutlookObj.CreateItem(0)
With xEmailObj
.Display
.To = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
.Attachments.Add xFolder
If DisplayEmail = False Then
'.Send
End If
End With
Else
MsgBox "The active worksheet cannot be blank"
Exit Sub
End If
Unload Me
CLOSE1.Show
End Sub
Я просто не уверен, как настроить его так, как мне нужно. Как я уже говорил, все остальное работает, мне просто нужно сохранить его в качестве диапазона и даты.
1 ответ
Без объяснения я не уверен, как весь этот код является относительным, но принимая клетку B3
содержит только текст, ваш пример близок - но отсутствуют кавычки.
Так должно быть:
Range("B3") & Format(Now(), "ddmmyy")