Как получить имя файла в = диапазон ("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")
Другие вопросы по тегам