EDN Admin
Well-known member
Hello,
I currently have a program that I created using Visual Studio Express 2012 for Desktop. The program is basically a bunch of Forms with radio buttons where a user chooses the report listed next to the radio button, then clicks a "run" button. It then searches
for the report is a designated "output" folder and if it finds the report it sends it as an attachment via e-mail to the defined recipients. If it does not find the report then it opens the report software to run the report. The user is then instructed to
go to File - Save As and save the report as an Excel spreadsheet (via a message box). I have the reports saved in specific folders based on their date/frequency (monthly, daily, Fridays etc.). Then I have the program move the file from said folder to the original
"output" folder and continue on with the code. This worked for a while, but now recently for some reason when the user clicks File - Save As it is not defaulting to the original folder in which the report is saved to (daily etc.). So then the program
produces an error and comes to a halt. The user gets frustrated because they try again and again with the same results.
With that said, I have attempted to add a Find File code to the string of where the spreadsheet is saved. However, when I save the report initially, I get the error but the second time I run the program it goes through. I am not sure what I am doing wrong
with my code. Can someone help me?
BTW I have various definitions setup at the module level which is why you will see things like reports.report.
This is the code for the find file function:
<pre class="prettyprint lang-vb" style=" Module Search
Public Const MAX_PATH = 260
Declare Function SearchTreeForFile Lib "IMAGEHLP.DLL" _
(ByVal lpRootPath As String, _
ByVal lpInputName As String, _
ByVal lpOutputName As String) As Long
Public Function FindFile(RootPath As String, _
FileName As String) As String
Dim lNullPos As Long
Dim lResult As Long
Dim sBuffer As String
On Error GoTo FileFind_Error
Allocate buffer
sBuffer = Space(MAX_PATH * 2)
Find the file
lResult = SearchTreeForFile(RootPath, FileName, sBuffer)
Trim null, if exists
If lResult Then
lNullPos = InStr(sBuffer, vbNullChar)
If Not lNullPos Then
sBuffer = Left(sBuffer, lNullPos - 1)
End If
Return filename
FindFile = sBuffer
Else
Nothing found
FindFile = vbNullString
End If
Exit Function
FileFind_Error:
FindFile = vbNullString
End Function
End Module[/code]
<br/>
This is the report I have tested it on:
<pre class="prettyprint lang-vb" style=" Sub MyReport()
Dim Report As String
Dim Done As String
Dim Report2 As String
Dim Done2 As String
Dim Report3 As String
Dim Done3 As String
On Error GoTo error_handler
Define the report date
If Date.Now.DayOfWeek = DayOfWeek.Monday Then
TDY = Format(DateAdd("d", -3, Today()), "MM-dd-yy")
Else
TDY = Format(DateAdd("d", -1, Today()), "MM-dd-yy")
End If
Define the report names
Report = Reports.ReportName
Report2 = Reports2.ReportName2
Report3 = Reports3.ReportName3
Define the Excel Spreadsheets that should be there
Excel = MyOutput & Report & MyExcel
Excel2 = MyOutput & Report2 & MyExcel
Excel3 = MyOutput & Report3 & MyExcel
Define where the spreadsheets are saved if the Cognos report(s) have to run
Saved = FindFile(RootPath:="PathtoreportsAutomated", FileName:=Report & MyExcel)
Saved2 = FindFile(RootPath:="PathtoreportsAutomated", FileName:=Report2 & MyExcel)
Saved3 = FindFile(RootPath:="PathtoreportsAutomated", FileName:=Report3 & MyExcel)
Define where the spreadsheets are saved after e-mailing
Done = MyDone & Report & " " & TDY & MyExcel
Done2 = MyDone & Report2 & " " & TDY & MyExcel
Done3 = MyDone & Report3 & " " & TDY & MyExcel
Check if the Excel file exists. If not display an error message then run the Cognos Report
If My.Computer.FileSystem.FileExists(Excel) = False Then
MsgBox(MyThe & Report & MyNotSaved, MsgBoxStyle.Critical, MyNotice)
Open Cognos Report
DailyReports.Report1()
Message asking user to hit OK when done
MsgBox(MyOK, MsgBoxStyle.Information, MyOKTitle)
Move the report from where it was saved
My.Computer.FileSystem.MoveFile(Saved, Excel)
End If
Check if the Excel file exists. If not display an error message then run the Cognos Report
If My.Computer.FileSystem.FileExists(Excel2) = False Then
MsgBox(MyThe & Report2 & MyNotSaved, MsgBoxStyle.Critical, MyNotice)
Open Cognos Report
DailyReports.Report2()
Message asking user to hit OK when done
MsgBox(MyOK, MsgBoxStyle.Information, MyOKTitle)
Move the report from where it was saved
My.Computer.FileSystem.MoveFile(Saved2, Excel2)
End If
Check if the Excel file exists. If not display an error message then run the Cognos Report
If My.Computer.FileSystem.FileExists(Excel3) = False Then
MsgBox(MyThe & ReturnReport & MyNotSaved, MsgBoxStyle.Critical, MyNotice)
Open Cognos Report
DailyReports.Report3()
Message asking user to hit OK when done
MsgBox(MyOK, MsgBoxStyle.Information, MyOKTitle)
Move the report from where it was saved
My.Computer.FileSystem.MoveFile(Saved3, Excel3)
End If
Move the reports
My.Computer.FileSystem.MoveFile(Excel, Done, FileIO.UIOption.AllDialogs, FileIO.UICancelOption.DoNothing)
My.Computer.FileSystem.MoveFile(Excel2, Done2, FileIO.UIOption.AllDialogs, FileIO.UICancelOption.DoNothing)
My.Computer.FileSystem.MoveFile(Excel3, Done3, FileIO.UIOption.AllDialogs, FileIO.UICancelOption.DoNothing)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ E-mail and attachments ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ObjMsg = CreateObject("CDO.Message")
objConf = CreateObject("CDO.Configuration")
objFlds = objConf.Fields
With objFlds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "ip address"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update()
End With
strBody = "<font point-size=11 face=Calibri>Hello,<br>Here is the " & Report & " " & Report2 & " " & Report3 & " for " & TDY & "." & vbCrLf
strBody = strBody & MySign.ShowSign() & vbCrLf
With ObjMsg
.Configuration = objConf
.To = "email@email.com"
.cc = "email2@email.com"
.bcc = "email3@email.com"
.From = From.ReportsAddress
.Subject = "Reports for " & TDY
.HTMLBody = strBody
.AddAttachment(Done)
.AddAttachment(Done2)
.AddAttachment(Done3)
.Send()
End With
Let the user know it went through
MsgBox(MyThe & Report & " " & Report2 & " " & Report3 & MySent)
Exit Sub
error_handler:
MsgBox(MyError, MsgBoxStyle.Information, MyRestart)
End Sub[/code]
<br/>
PS- I am self taught on Visual Basic via youtube and forums.
<
Have a great day! Rachel
<br/>
View the full article
I currently have a program that I created using Visual Studio Express 2012 for Desktop. The program is basically a bunch of Forms with radio buttons where a user chooses the report listed next to the radio button, then clicks a "run" button. It then searches
for the report is a designated "output" folder and if it finds the report it sends it as an attachment via e-mail to the defined recipients. If it does not find the report then it opens the report software to run the report. The user is then instructed to
go to File - Save As and save the report as an Excel spreadsheet (via a message box). I have the reports saved in specific folders based on their date/frequency (monthly, daily, Fridays etc.). Then I have the program move the file from said folder to the original
"output" folder and continue on with the code. This worked for a while, but now recently for some reason when the user clicks File - Save As it is not defaulting to the original folder in which the report is saved to (daily etc.). So then the program
produces an error and comes to a halt. The user gets frustrated because they try again and again with the same results.
With that said, I have attempted to add a Find File code to the string of where the spreadsheet is saved. However, when I save the report initially, I get the error but the second time I run the program it goes through. I am not sure what I am doing wrong
with my code. Can someone help me?
BTW I have various definitions setup at the module level which is why you will see things like reports.report.
This is the code for the find file function:
<pre class="prettyprint lang-vb" style=" Module Search
Public Const MAX_PATH = 260
Declare Function SearchTreeForFile Lib "IMAGEHLP.DLL" _
(ByVal lpRootPath As String, _
ByVal lpInputName As String, _
ByVal lpOutputName As String) As Long
Public Function FindFile(RootPath As String, _
FileName As String) As String
Dim lNullPos As Long
Dim lResult As Long
Dim sBuffer As String
On Error GoTo FileFind_Error
Allocate buffer
sBuffer = Space(MAX_PATH * 2)
Find the file
lResult = SearchTreeForFile(RootPath, FileName, sBuffer)
Trim null, if exists
If lResult Then
lNullPos = InStr(sBuffer, vbNullChar)
If Not lNullPos Then
sBuffer = Left(sBuffer, lNullPos - 1)
End If
Return filename
FindFile = sBuffer
Else
Nothing found
FindFile = vbNullString
End If
Exit Function
FileFind_Error:
FindFile = vbNullString
End Function
End Module[/code]
<br/>
This is the report I have tested it on:
<pre class="prettyprint lang-vb" style=" Sub MyReport()
Dim Report As String
Dim Done As String
Dim Report2 As String
Dim Done2 As String
Dim Report3 As String
Dim Done3 As String
On Error GoTo error_handler
Define the report date
If Date.Now.DayOfWeek = DayOfWeek.Monday Then
TDY = Format(DateAdd("d", -3, Today()), "MM-dd-yy")
Else
TDY = Format(DateAdd("d", -1, Today()), "MM-dd-yy")
End If
Define the report names
Report = Reports.ReportName
Report2 = Reports2.ReportName2
Report3 = Reports3.ReportName3
Define the Excel Spreadsheets that should be there
Excel = MyOutput & Report & MyExcel
Excel2 = MyOutput & Report2 & MyExcel
Excel3 = MyOutput & Report3 & MyExcel
Define where the spreadsheets are saved if the Cognos report(s) have to run
Saved = FindFile(RootPath:="PathtoreportsAutomated", FileName:=Report & MyExcel)
Saved2 = FindFile(RootPath:="PathtoreportsAutomated", FileName:=Report2 & MyExcel)
Saved3 = FindFile(RootPath:="PathtoreportsAutomated", FileName:=Report3 & MyExcel)
Define where the spreadsheets are saved after e-mailing
Done = MyDone & Report & " " & TDY & MyExcel
Done2 = MyDone & Report2 & " " & TDY & MyExcel
Done3 = MyDone & Report3 & " " & TDY & MyExcel
Check if the Excel file exists. If not display an error message then run the Cognos Report
If My.Computer.FileSystem.FileExists(Excel) = False Then
MsgBox(MyThe & Report & MyNotSaved, MsgBoxStyle.Critical, MyNotice)
Open Cognos Report
DailyReports.Report1()
Message asking user to hit OK when done
MsgBox(MyOK, MsgBoxStyle.Information, MyOKTitle)
Move the report from where it was saved
My.Computer.FileSystem.MoveFile(Saved, Excel)
End If
Check if the Excel file exists. If not display an error message then run the Cognos Report
If My.Computer.FileSystem.FileExists(Excel2) = False Then
MsgBox(MyThe & Report2 & MyNotSaved, MsgBoxStyle.Critical, MyNotice)
Open Cognos Report
DailyReports.Report2()
Message asking user to hit OK when done
MsgBox(MyOK, MsgBoxStyle.Information, MyOKTitle)
Move the report from where it was saved
My.Computer.FileSystem.MoveFile(Saved2, Excel2)
End If
Check if the Excel file exists. If not display an error message then run the Cognos Report
If My.Computer.FileSystem.FileExists(Excel3) = False Then
MsgBox(MyThe & ReturnReport & MyNotSaved, MsgBoxStyle.Critical, MyNotice)
Open Cognos Report
DailyReports.Report3()
Message asking user to hit OK when done
MsgBox(MyOK, MsgBoxStyle.Information, MyOKTitle)
Move the report from where it was saved
My.Computer.FileSystem.MoveFile(Saved3, Excel3)
End If
Move the reports
My.Computer.FileSystem.MoveFile(Excel, Done, FileIO.UIOption.AllDialogs, FileIO.UICancelOption.DoNothing)
My.Computer.FileSystem.MoveFile(Excel2, Done2, FileIO.UIOption.AllDialogs, FileIO.UICancelOption.DoNothing)
My.Computer.FileSystem.MoveFile(Excel3, Done3, FileIO.UIOption.AllDialogs, FileIO.UICancelOption.DoNothing)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ E-mail and attachments ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ObjMsg = CreateObject("CDO.Message")
objConf = CreateObject("CDO.Configuration")
objFlds = objConf.Fields
With objFlds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "ip address"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update()
End With
strBody = "<font point-size=11 face=Calibri>Hello,<br>Here is the " & Report & " " & Report2 & " " & Report3 & " for " & TDY & "." & vbCrLf
strBody = strBody & MySign.ShowSign() & vbCrLf
With ObjMsg
.Configuration = objConf
.To = "email@email.com"
.cc = "email2@email.com"
.bcc = "email3@email.com"
.From = From.ReportsAddress
.Subject = "Reports for " & TDY
.HTMLBody = strBody
.AddAttachment(Done)
.AddAttachment(Done2)
.AddAttachment(Done3)
.Send()
End With
Let the user know it went through
MsgBox(MyThe & Report & " " & Report2 & " " & Report3 & MySent)
Exit Sub
error_handler:
MsgBox(MyError, MsgBoxStyle.Information, MyRestart)
End Sub[/code]
<br/>
PS- I am self taught on Visual Basic via youtube and forums.
<
Have a great day! Rachel
<br/>
View the full article