Hi Guys I really need assistance with the below code. I am using the following codes to import data into 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

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

Importing the following which works fine

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

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

My problem is exporting the selected range to 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

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

or

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

================================================================
Each time i try to export after importing data i get error 1004

enter image description here

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

Without imported data I can export with the code. But after importing data I can't export again.

I keep getting "application-defined or object-defined error" and Run-time error'1004' Document not saved. the document may be open, or an error may have encountered when saving..

this is the first code that is highlighed when i debug

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

Second code error

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

enter image description here

Kindly find the following error msgs coming from subreport and button 2

Sheet1

Subreport Subreport

Button 2 commandButton2

  • 3
    Please specify the line of code that generates the error. – Excellll Jun 13 at 14:14
  • While I doubt that this is your problem, I spotted a logic flaw that could potentially cause problems: found = InStr(txt, k) + Len(k) + 1 will always return a value >0 (checked as such on the next line). Even if the text k is not found (returns -1) you add len(k) and 1 (assuming k is never "") Like I said, probably never fails anyway but, it could. – Bill Hileman Jun 13 at 15:03
  • I have updated the code with the line that is throwing the error. Plz assist – gist102 Jun 13 at 21:21
up vote 1 down vote accepted

There are invalid special characters in the file name when saving the PDFs

Procedures CleanFileName & CleanUsedRange remove \ / : * ? | < > " 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

.

How to use the procedures in your subs


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

.

Add both CleanFileName and CleanUsedRange to a generic module

For example Module1

Code

Your Answer

 
discard

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.

Not the answer you're looking for? Browse other questions tagged or ask your own question.