Email Attachment only working when statically coded - Excel Visual Basic - excel

Everything is working for me in sending an email with an attachment from Excel using Visual Basic via Thunderbird when the attachment path is hard-coded.
attachment=C:\Users\Desktop2017\Desktop\customer\customerNumber\invoiceNumber.pdf"
But I need to change part of the file path for attachment based on what's in cell M4 and have the file name change based on what's in cell J4.
Example: M4 value is currently 101. J4 value is currently 2000-01. The output should be "C:\Users\Desktop2017\Desktop\customer\101\2000-01.pdf"
I have tried using 'Range' to get the value and setting a string but instead of getting the data from the cell or string it just outputs whatever I have after the equals sign.
I've tried adding and moving quotation marks around but nothing has worked at this point.
Thanks in advance for any help, Dalton.
PS: Sorry for hobbled together code.
Private Sub EmailInvoice_Click()
Dim FileNumber As Integer
Dim retVal As Variant
Dim strName As String
Dim strFile As String
Dim wsCustomer As Worksheet
strName = Range("Q2").Value
strFile = Dir(strFolder & "*.xlsx")
Const MY_FILENAME = "C:\Users\Desktop2017\Dropbox\temp\invoice.BAT"
FileNumber = FreeFile
'create batch file
Open MY_FILENAME For Output As #FileNumber
Print #FileNumber, "cd ""C:\Program Files (x86)\Mozilla Thunderbird"""
Print #FileNumber, "thunderbird -compose"; _
" to=" + ThisWorkbook.Sheets("hourlyInvoice01").Range("N21") _
+ ",subject=Invoice " + ThisWorkbook.Sheets("hourlyInvoice01").Range("J4") + ",format="; 1; _
",body=""<HTML><BODY>Hello "; ThisWorkbook.Sheets("hourlyInvoice01").Range("N20") _
+ "&#44<BR><BR>Please see attached.<BR><BR>Thanks&#44 Dalton.<BR><BR><BR>Contact Info Text Line 1<BR>Contact Info Text Line 2<BR>Contact Info Text Line 3</BODY></HTML>"",attachment=C:\Users\Desktop2017\Desktop\test\script\someFile.txt"
Print #FileNumber, "exit"
Close #FileNumber
'run batch file
retVal = Shell(MY_FILENAME, vbNormalFocus)
' NOTE THE BATCH FILE WILL RUN, BUT THE CODE WILL CONTINUE TO RUN.
If retVal = 0 Then
MsgBox "An Error Occured"
Close #FileNumber
End
End If
'Delete batch file
'Kill MY_FILENAME
End Sub

Add this before that line
Dim FlName As String
FlName = "C:\Users\Desktop2017\Desktop\customer\" & Range("M4").Value & "\" & Range("J4").Value & ".pdf"
and then change the line
"&#44<BR><BR>Please see attached.<BR><BR>Thanks&#44 Dalton.<BR><BR><BR>Contact Info Text Line 1<BR>Contact Info Text Line 2<BR>Contact Info Text Line 3</BODY></HTML>"",attachment=C:\Users\Desktop2017\Desktop\test\script\someFile.txt"
to
"&#44<BR><BR>Please see attached.<BR><BR>Thanks&#44 Dalton.<BR><BR><BR>Contact Info Text Line 1<BR>Contact Info Text Line 2<BR>Contact Info Text Line 3</BODY></HTML>"",attachment=" & FlName
Note: To concatenate strings, use & instead of +

Related

Open file dynamically in Visual Basic

My goal is to open a excel file inside a Visual Basic Macro in a Word file.
The two files (the word file with the macro and the excel file I want to open) are in the same folder, named like this:
C:/.../123 - 345823847/123 - OTE.xlsx
As you can see, the file have a name composed by a number and " - OTE.xlsx", and that number is the same as the first number in the name of the folder that contains the two files.
Sub SuperMacroFV()
Dim Excel
Set Excel = CreateObject("Excel.Application")
Excel.Visible = True
Set wb_datos = Excel.Workbooks.Open(ActiveDocument.Path & "\"{the number here}" - OTE.xlsx")
My goal is to try to open the file dynamically by knowing the number of the file by obtaining it from the name of the folder.
Another option could be to open the file knowing that it is always ended with OTE.xlsx.
If your Excel file is in the same folder than your Word file, try this:
Sub SuperMacroFV()
Dim Excel As Object
Dim vPath As String
Set Excel = CreateObject("Excel.Application")
Excel.Visible = True
vPath = Split(ActiveDocument.Path, "\")(UBound(Split(ActiveDocument.Path, "\"))) 'last folder of path
vPath = Split(vPath, " - ")(0) 'pattern is 123 - 345823847 and we need everything before dash (123), first position of array
Set wb_datos = Excel.Workbooks.Open(ActiveDocument.Path & "\" & vPath & " - OTE.xlsx")
End Sub
One way:
Dim pos As Long
Dim file As String
'// get position of the last \
pos = InStrRev(ActiveDocument.Path, "\")
'// extract from the last \ to the first space
file = Mid$(ActiveDocument.Path, pos + 1, InStr(pos, ActiveDocument.Path, " ") - pos - 1)
'// final
file = ActiveDocument.Path & "\" & file & " - OTE.xlsx"

Excel VBA : Run Time Error 1004 : Excel cannot access to file

I am creating a macro of the report generator that let the user to save a copy of the file to its destination.
Cell value ("E5") is where the user input the date.
Cell value ("E11") is where user keyin the record name (in this case colour values)
The macro will save it to the location in the C drive
Here are the code :
Sub CTemplate()
'Select up the macro generator
Sheets("File Generator").Select
'Save file according to the textbox values
Dim filename As String
Dim varDatevalue As String
Dim varColourvalue As String
varDatevalue = Range("E5").Value
varColourvalue = Range("E11").Value
ActiveWorkbook.SaveAs filename:="C:\Colour Log\" & varDatevalue & "--" & varColourvalue & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
However, there are some problems as I encounter to run time error:
I already tried as followed:
Debugging and search for SO but couldn't find any one else with the same problems
I already created the folder at the desired locations
Uncheck ("Read Only") check box for the file so it can be written
Thank you .
"A filename cannot contain any of the following characters: \ / : * ? " < > |" - your file name seems to be "5\11\4192C700" which effectively means that you are trying to save your file in a non-existent directory c:\Colour Log\5\11\4192C700. You have to change the slashes in the file name for other characters.
The '\ / : * ? < > | [ ] "' Issue
Sub CTemplate()
'Always place values, especially text into constants, so you can
'quickly change them and you don't have to search and change them
'wherever they appear in the code.
Const cStrPath As String = "C:\Colour Log\"
Const cStrWsName As String = "File Generator"
Const cStrDateCell As String = "E5"
Const cStrColorCell As String = "E11"
Dim arrNope As Variant
Dim strNope As String
Dim strFileName As String
Dim strDate As String
Dim strColour As String
Dim intNope As Integer
'Characters you can't have in a filename
strNope = "\ / : * ? < > | [ ] " & Chr(34) 'Chr(34) is double quotes (")
'You can add other characters like "." if you don't want them in the
'filename, just make sure to separate the characters and end the string
'with a space (" ").
'Paste the characters into an array
arrNope = Split(strNope)
'Calculate strings
With Worksheets(cStrWsName)
'Loop through the array of characters
For intNope = LBound(arrNope) To UBound(arrNope)
'With 'Cstr' you coerce each value to a string data type.
'With 'Replace' you replace each character with "", practically you
'delete each 'unwanted' character if it is found.
strDate = Replace(CStr(.Range(cStrDateCell).Value), _
arrNope(intNope), "")
Next
'Coerce the value to a string datatype
strColour = CStr(.Range(cStrColorCell).Value)
End With
'Calculate filename
strFileName = cStrPath & strDate & "--" & strColour & ".xlsm"
'The following line is used only to suppress the error that could occur when
'a file already exists and at the prompt "No" or "Cancel" is selected.
On Error Resume Next
'Save the file
ActiveWorkbook.SaveAs filename:=strFileName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

Excel VBA extra Newline getting inserted through print statement

Through a Excel VBA macro, I'm trying to print up to 10 space seperated arguments for a selected range in excel.
For example, I have the 24 values in my selection range A1:A24 - (say Val1, Val2, Val3, Val4, etc.)
Using the following VBA code, I want to get the output in the "outfile.bat" as
"C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" Val1 Val2.... Val10
"C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" Val11 Val2.... Val20
"C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" Val21 Val22 Val23 Val24
i.e. each line should get printed with maximum of 10 argument values (seperated by a space). Anything above that should be moved to next line (again max of 10 space seperated arguments)
Somehow, the following code is
(1) NOT keeping the output to the same line and
(2) Inserts a newline at the 10th value, but not at the 20th, 30th and other values.
It produces the following:
"C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
Val1
"C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
Val2
C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
Val3
and so on....
Here is my code:
Private Sub GetChromeFile_Click()
Dim myFile As String, rng As Range, cellValue As Variant, i As Integer, j As Integer, a As Integer
myFile = "C:\Users\User1\" & "outfile.bat"
Set rng = Selection
Open myFile For Output As #7
a = 0
For i = 1 To rng.Rows.Count
Print #7, Chr(34) & "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" & Chr(34)
a = a + 1
cellValue = rng.Cells(i).Value
If (a = 10) Then
Print #7, " " & cellValue & vbNewLine
Else
Print #7, " " & cellValue
End If
Next i
Close #7
Range("F5").Value = " Done!"
End Sub
Please let me know where this may be going wrong.
Thanks
The print statement prints a line to the file, so adding vbNewLine at the end of each is redundant. You're also making calls to Print for each argument value (cellValue in your code), which is why those are appearing on their own line.
You can most likely construct the entire file contents as a single string, and then use a single Print statement to write the whole file. If you're dealing with an enormous amount of data, you may need to segment it but for most cases this should work:
Option Explicit
Sub writebat()
Const pathTxt$ = """C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"" "
Dim lineTxt As String
Dim cellValue As String
Dim fname As String
Dim ff As Long
Dim a As Long
Dim i As Long
Dim rng As Range
Set rng = Selection ' Range("A1:A37")
fname = "C:\Users\User1\" & "outfile.bat" ' "C:\debug\output.txt"
ff = FreeFile()
Open fname For Output As #ff
lineTxt = pathTxt
a = 1
For i = 1 To rng.Rows.Count
'## Add the cell value to the string
lineTxt = lineTxt & rng.Cells(i).Value & " "
If a Mod 10 = 0 Then
'## Start a new line with the executable path
lineTxt = lineTxt & vbNewLine & pathTxt
End If
a = a + 1
Next
Print #ff, lineTxt
Close #ff
End Sub
This yields the following output:

VBA Excel Macro error: 1004 unable to get the substitute property of the WorkbooFunction class

I am using a vba macro to find a big string in a text file.
For that I read the text file , read the text to compare (which is saved in one of the cell). After that i would replace CRLF with CR (since the saved text does not contain CRLF). Then compare. Its working fine if the file size is less. But throwing the error when the file size is high (Around 50 KB is fine).
Any guess about the maximum size of the file?
The below part of the code is throwing error
Open LogFilePath For Input As #iFile
strFileContent = Input(LOF(iFile), iFile)
Close #iFile
strFileContent = Application.WorksheetFunction.Substitute(strFileContent, vbCrLf, "")
strSearch = Application.WorksheetFunction.Substitute(strSearch, vbLf, "")
strFileContent = Application.WorksheetFunction.Substitute(strFileContent, vbTab, " ")
If InStr(1, strFileContent, strSearch, vbBinaryCompare) > 0 Then
SearchTextFile = "success"
Else
SearchTextFile = "failed"
End If
Any guess or suggestion please.
I note the error refers to the Substitute property and that you are using Application.WorksheetFunction.Substitute.
Personally, in VBA I always tend to use the REPLACE function which works in the same way.
I also use this when processing some large .txt files (20,000 rows/30MB) and don't encounter problems with it.
The Substitute is more for use e.g. with a cell formula. You should try following code snippet using Replace for your needs.
Private Sub CommandButton1_Click()
Dim LogFilePath As String
Dim ifile As Integer
ifile = 1
LogFilePath = "D:/_working/application-log-file-small.txt"
strSearch = "Temp Path :"
Open LogFilePath For Input As #ifile
strFileContent = Input(LOF(ifile), ifile)
Close #ifile
'--- Show len of file content string -----
MsgBox (Len(strFileContent))
strFileContent = Replace(strFileContent, vbCrLf, "")
strSearch = Replace(strSearch, vbLf, "")
strFileContent = Replace(strFileContent, vbTab, " ")
If InStr(1, strFileContent, strSearch, vbBinaryCompare) > 0 Then
SearchTextFile = "success"
MsgBox ("success")
Else
SearchTextFile = "failed"
MsgBox ("failed")
End If
End Sub

EXCEL VBA Write - Read File - BUG?

I've been wracking my brains with a file input problem, I've finally got it down to two problems, I can get past the error 62, "Read past End of file", but this one I can't get past.
Can someone tell me if I'm doing anything wrong / verify?
Basically the (this) code writes two lines#
?xml version="1.0"?
A Second Line
the debug statement in Part 1 (write file) prints the text as
?xml version="1.0"?
A Second Line
the debug statement in Part 2 (read file) prints the text as
ÿþ?xml version="1.0"?
A Second Line
As you can see, there are two extra characters being added to the either the input or
the output stream at the beginning of the file.
A second line has been added for completeness to show in more detail that it is only the first line that is being screwed.
When I look through Notepad there is nothing extra, what/where are these extras coming from?
Any thoughts, thanks in advance,
regards
Seán
Sub writeXMLTest()
'Part 1 - Write the file
Dim FSO As Object
Dim NewFile As Object
Dim FullPath As String
Dim XMLFileText As String
FullPath = "E:\TESTFILE.xml"
'On Error GoTo Err:
Set FSO = CreateObject("Scripting.FileSystemObject")
Set NewFile = FSO.CreateTextFile(FullPath, 1, 1)
XMLFileText = ""
XMLFileText = XMLFileText & "?xml version=" & Chr(34) & "1.0" & Chr(34) & "?" & vbNewLine
NewFile.Write (XMLFileText)
Debug.Print XMLFileText
XMLFileText = XMLFileText & "A Second Line" & vbNewLine
NewFile.Write (XMLFileText)
Debug.Print XMLFileText
NewFile.Close
'Part 1 - Complete
'Part 2 - Now to read the file
Dim FileNum As Integer, i As Integer
Dim s As String
' fpath = Application.GetOpenFilename
FileNum = FreeFile()
Open FullPath For Input As #FileNum
i = 1
While Not EOF(FileNum)
Line Input #FileNum, s ' read in data 1 line at a time
Debug.Print s
Wend
End Sub
Just a quick shot: Generally, xml-files use UTF8 encoding. But the FileSystemObject cannot handle UTF8. You can do this (read and write UTF8-Files in VBA) with an ADODB.Stream object - you'll find examples across the web.

Resources