Ошибка VBA 1004 при экспорте в PDF

Question

Привет, ребята. Мне очень нужна помощь с кодом ниже. Я использую следующие коды для импорта данных в Excel:

Option Explicit

Private Sub CommandButton1_Click()
Const FULL_PATH = "C:\Users\Documents\test\customerinformation.txt"
Dim fId As String, txt As String, txtLen As Long, d As Object, dc As Long

fId = FreeFile
Open FULL_PATH For Input As fId
    txt = Input(LOF(fId), fId)  'Read entire file (not line-by-line)
Close fId
txtLen = Len(txt)
Set d = CreateObject("Scripting.Dictionary")
d("Name") = "C11"   'Same as: d.Add Key:="Name", Item:="C11"
d("Phone") = "H13"
d("Address1") = "C15"
d("Email") = "C13"
d("Postcode") = "H16"
d("SR") = "C10"
d("MTM") = "H14"
d("Serial") = "H15"
d("Problem") = "C17"
d("Action") = "C18"
d("Dated") = "H10"
dc = d.Count

Dim i As Long, k As String, sz As Long, found As Long
With ThisWorkbook.Worksheets("Sheet1")     '<--- Update sheet name
    For i = 0 To dc - 1     'd.Keys()(i) is a 0-based array
        k = d.Keys()(i)     'Name, Phone, etc
        found = InStr(txt, k) + Len(k) + 1  'Find the (first) key in file
        If found > 0 Then   'Determine item length by finding the next key
            If i < dc - 1 Then sz = InStr(txt, d.Keys()(i + 1)) Else sz = 
txtLen + 2
            .Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 1))
        End If
    Next
End With
End Sub

================================================== ==============

Импортирование следующего, который отлично работает

Name Name1
Phone Phone1
Address1 Address11
Email Email1
Postcode Postcode1
SR SR1
MTM MTM1
Serial Serial1
Problem Problem1
Action Action1
Dated Dated1

===============================================

Моя проблема заключается в экспорте выбранного диапазона в PDF

Private Sub CommandButton2_Click()

Dim FilePath As String
Dim FileName As String
Dim MyDate As String
Dim report As String
Dim Name As String

FilePath = "C:\Users\Documents\test\"
MyDate = Format(Date, " - MM-DD-YYYY")
report = " - Quatation"
Name = Worksheets("Sheet1").Range("C10")

Sheets("Sheet1").Range("A1:I60").ExportAsFixedFormat Type:=xlTypePDF, _
FileName:=FilePath & Name & MyDate & report


End Sub

================================================== ========

или же

Private Sub report()

Dim myFile As String, lastRow As Long
myFile = "C:\Users\heal1\OneDrive\Documents\test\" & 
Sheets("Sheet1").Range("C11") & "_" & Sheets("Sheet1").Range("C17") & 
Format(Now(), "yyyy-mm-dd") & ".pdf"
lastRow = Sheets("Sheet3").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
'Transfer data to sheet3
Sheets("Sheet3").Cells(lastRow, 1) = Sheets("Sheet1").Range("C11")
Sheets("Sheet3").Cells(lastRow, 2) = Sheets("Sheet1").Range("C17")
Sheets("Sheet3").Cells(lastRow, 3) = Sheets("sheet1").Range("I28")
Sheets("Sheet3").Cells(lastRow, 4) = Now
Sheets("Sheet3").Hyperlinks.Add Anchor:=Sheets("Sheet3").Cells(lastRow, 5), 
Address:=myFile, TextToDisplay:=myFile
'Create invoice in PDF format
Sheets("sheet1").ExportAsFixedFormat Type:=xlTypePDF, FileName:=myFile
Application.DisplayAlerts = False
'create invoice in XLSX format
ActiveWorkbook.SaveAs "C:\Users\Documents\test\" & 
Sheets("Sheet1").Range("C11") & "_" & Sheets("Sheet1").Range("C17") & "_" & 
Format(Now(), "yyyy-mm-dd") & ".xlsx", FileFormat:=51
'ActiveWorkbook.Close
Application.DisplayAlerts = True


End Sub

================================================== ==============
Каждый раз, когда я пытаюсь экспортировать после импорта данных, я получаю ошибку 1004

================================================== ==========

Без импортированных данных я могу экспортировать с кодом. Но после импорта данных я не могу экспортировать снова.

Я получаю сообщение « Ошибка приложения или объекта» и Ошибка выполнения 1004 «Документ не сохранен. Возможно, документ открыт или при сохранении произошла ошибка.

это первый код, который выделяется при отладке

Sheets("Sheet1").Range("A1:I60").ExportAsFixedFormat Type:=xlTypePDF, _ 
FileName:=FilePath & Name & MyDate & Report –

Вторая ошибка кода

Sheets("sheet1").ExportAsFixedFormat Type:=xlTypePDF, FileName:=myFile

введите описание изображения здесь

Пожалуйста, найдите следующие сообщения об ошибках из подотчета и кнопку 2

Лист1

Подотчет Подотчет

Кнопка 2 commandButton2

Answer 1

При сохранении PDF-файлов в имени файла содержатся недопустимые специальные символы

Процедуры CleanFileName & CleanUsedRange удалить \ / : * ? | < > " Backspace Tab LF CR

---

Option Explicit

Public Function CleanFileName(ByVal fName As String) As String
    Dim b() As Byte, specialChars As Variant, i As Long

    b = "\/:*?|<>" & Chr(34) & Chr(8) & Chr(9) & Chr(10) & Chr(13)

    specialChars = Split(StrConv(b, vbUnicode), Chr(0))

    fName = Trim$(fName)    'Trim, then remove \ / : * ? | < > " Backspace Tab LF CR
    For i = 0 To UBound(specialChars)
        fName = Replace(fName, specialChars(i), vbNullString)
    Next
    CleanFileName = fName
End Function

---

Public Sub CleanUsedRange(ByRef ur As Range)
    Dim arr As Variant, r As Long, c As Long

    arr = ur.Formula
    For r = 1 To UBound(arr, 1)
        For c = 1 To UBound(arr, 2)
            arr(r, c) = CleanFileName(arr(r, c))
        Next
    Next
    ur.Formula = arr
End Sub

---

,

Как использовать процедуры в ваших сабвуферах

---

Private Sub CommandButton2_Click()
    Dim ws As Worksheet, fPath As String, fName As String, dt As String

    Set ws = ThisWorkbook.Worksheets("Sheet1")

    fPath = "C:\Users\Documents\test\"
    dt = Format(Date, " - MM-DD-YYYY")

    CleanUsedRange ws.UsedRange

    fName = fPath & ws.Range("C10") & dt & " - Quatation"

    ws.Range("A1:I60").ExportAsFixedFormat Type:=xlTypePDF, FileName:=fName
End Sub

---

Private Sub SaveReport()
    Const FILE_PATH_1 = "C:\Users\heal1\OneDrive\Documents\test\"
    Const FILE_PATH_2 = "C:\Users\Documents\test\"

    Dim ws1 As Worksheet, ws3 As Worksheet, fPath As String, dt As String

    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws3 = ThisWorkbook.Worksheets("Sheet3")
    dt = Format(Now, "yyyy-mm-dd")

    Dim cfn As String, fName As String, lr As Long

    CleanUsedRange ws1.UsedRange

    lr = ws3.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1

    'Transfer data to sheet3
    ws3.Cells(lr, 1) = ws1.Cells(11, "C")
    ws3.Cells(lr, 2) = ws1.Cells(17, "C")
    ws3.Cells(lr, 3) = ws1.Cells(28, "I")
    ws3.Cells(lr, 4) = Now  'or dt
    ws3.Hyperlinks.Add Anchor:=ws3.Cells(lr, 5), Address:=fName, TextToDisplay:=fName

    'Create invoice in PDF format
    cfn = ws1.Range("C11") & "_" & ws1.Range("C17")
    fName = FILE_PATH_1 & cfn & dt & ".pdf"
    ws1.ExportAsFixedFormat Type:=xlTypePDF, FileName:=fName

    'create invoice in XLSX format
    Application.DisplayAlerts = False
    fName = FILE_PATH_2 & cfn & "_" & dt & ".xlsx"
    ThisWorkbook.SaveAs fName, FileFormat:=51
    'ActiveWorkbook.Close
    Application.DisplayAlerts = True
End Sub

---

,

Добавьте как CleanFileName и CleanUsedRange в универсальный модуль

Например, Module1