Chinese filename as an attachment in email - vb.net

Following is simple code to send the mail with an attachment:
/**************************************************/
Dim msgMail As New System.Web.Mail.MailMessage
Dim rcpName As String
Dim client As New SmtpClient
Dim i As Integer
Dim recips_addr() As String = Split(to_address, ";")
Dim recips_name() As String = Split(to_name, ";")
For i = 0 To recips_addr.Length - 1
rcpName = """" & recips_name(i) & """"
msgMail.To = rcpName & recips_addr(i) & ";"
Next
msgMail.From = from_address
msgMail.Subject = subject
msgMail.BodyFormat = System.Web.Mail.MailFormat.Html
msgMail.Body = message
msgMail.BodyEncoding = System.Text.Encoding.UTF8
If String.IsNullOrEmpty(attachment_path) Then attachment_path = "NONE"
If (attachment_path <> "NONE") Then
Dim att As New System.Web.Mail.MailAttachment(attachment_path)
msgMail.Attachments.Add(att)
End If
If send_to_sender Then
msgMail.Bcc = from_address
End If
msgMail.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = My.Settings.smtp_Server
msgMail.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
msgMail.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
msgMail.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
msgMail.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
msgMail.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = My.Settings.emailUsername
msgMail.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = My.Settings.emailPassword
System.Web.Mail.SmtpMail.Send(msgMail)
/**************************************************/
Now, the query is when i send a pdf file as an attachment using above code and file name is 'Report_出生地_出生地_出生地_6023.pdf'.
when i get the mail in my inbox the name of the file becomes 'Report____6023.pdf'.
I don't know why attachment filenames are changing.
Please help !!!!

Related

The copy process is very slow with this function vb.net

I use this function for copying some files from the Source folder to the Destination folder, but the copying is needed more time than usual.
Sub SyncFiles(Lbl_Percentage As Label, Lbl_FileName As Label, PrgrsBar As ProgressBar)
Try
Dim Sql As String = "SELECT GroupID FROM Tbl_Current"
Dim GetGroupID = MsAcc_RetriveTemp(Sql, 0)
Dim Sql1 As String = "Select * FROM Tbl_SyncPath where ID=" & GetGroupID
Dim Src As String = MsAcc_RetriveTemp(Sql1, 1)
Dim Des As String = MsAcc_RetriveTemp(Sql1, 2)
If Not IO.Directory.Exists(Des) Then IO.Directory.CreateDirectory(Des)
Dim fls() As String = IO.Directory.GetFiles(Des)
PrgrsBar.Value = 0
PrgrsBar.Maximum = fls.Count
For Each fn As String In fls
Dim filename As String = IO.Path.GetFileName(fn)
My.Computer.FileSystem.CopyDirectory(Des, Src, True)
PrgrsBar.Value += 1 'add 1 to the ProgressBar`s value
Dim Percntge As Integer = (PrgrsBar.Value / fls.Count) * 100
Lbl_Percentage.Text = Percntge & " %"
Lbl_FileName.Text = "جاري تحديث ملف: " & filename
Application.DoEvents()
Lbl_FileName.Text = "اكتمل عملية التحديث."
Next
Catch ex As Exception
End Try
End Sub
You copy all the files in the folder for each files.
For Each fn As String In fls
Dim filename As String = IO.Path.GetFileName(fn)
My.Computer.FileSystem.CopyDirectory(Des, Src, True) ' <--- No file specified
PrgrsBar.Value += 1 'add 1 to the ProgressBar`s value
Dim Percntge As Integer = (PrgrsBar.Value / fls.Count) * 100
Lbl_Percentage.Text = Percntge & " %"
Lbl_FileName.Text = "جاري تحديث ملف: " & filename
Application.DoEvents()
Lbl_FileName.Text = "اكتمل عملية التحديث."
Next
Put this outside the loop
My.Computer.FileSystem.CopyDirectory(Des, Src, True)
For Each fn As String In fls
' ...
Next
Also, seems like des and src are mixed up.

error deleting files after I send an email using VB Studio

Below is the email code I am using to send an email with attached document, but when I try to delete the files it is showing that the files are in use. Any help will be appreciated.
Sub email()
Dim Smtp_Server As New SmtpClient
Dim e_mail As New MailMessage()
Dim body As String
Dim address As String
Dim address2 As String
Dim address3 As String
Dim fileReader As System.IO.StreamReader
fileReader = My.Computer.FileSystem.OpenTextFileReader("C:\VB Test\location.txt")
Dim Pathstore As String
Pathstore = fileReader.ReadLine()
'email address
Dim lines() As String = System.IO.File.ReadAllLines("C:\VB Test\stores.txt")
For Each line As String In Filter(lines, Pathstore)
Dim fields() As String = line.Split(",")
address = fields(4)
address2 = fields(2)
address3 = fields(6)
Next
Dim fileReader2 As System.IO.StreamReader
fileReader2 = My.Computer.FileSystem.OpenTextFileReader("C:\VB Test\rmmsiul.dll")
Dim Pathcode As String
Pathcode = fileReader2.ReadLine()
fileReader2.Close()
body = "Here are the manual reciepts I created today." + vbNewLine + vbNewLine + vbNewLine & "Thank you," + vbNewLine + Pathstore
Smtp_Server.UseDefaultCredentials = False
Smtp_Server.Credentials = New Net.NetworkCredential("Do-Not-Reply#suncommobile.com", Pathcode)
Smtp_Server.Port = 587
Smtp_Server.EnableSsl = True
Smtp_Server.Host = "smtp.office365.com"
e_mail = New MailMessage()
e_mail.From = New MailAddress("Do-Not-Reply#suncommobile.com")
e_mail.CC.Add(address)
e_mail.CC.Add(address2)
e_mail.CC.Add(address3)
e_mail.Subject = Pathstore + " Manual reciepts"
e_mail.IsBodyHtml = False
e_mail.Body = body
Dim filepath As String
For Each filepath In Directory.GetFiles("C:\VB Test\Receipts")
Dim Attach As New Net.Mail.Attachment(filepath)
e_mail.Attachments.Add(Attach)
Kill(filepath)
Next
Smtp_Server.Send(e_mail)
MsgBox("E-mail Sent.")
Module1.filedelete()
End Sub
'changed part of the code to the following, but getting error when sending email.
For Each filepath As String In Directory.GetFiles("C:\VB Test\Receipts")
Using reader As New StreamReader(filepath)
Dim a As New Net.Mail.Attachment(reader.BaseStream, filepath)
e_mail.Attachments.Add(a)
End Using
Next
Smtp_Server.Send(e_mail)
Public Sub email()
Dim Pathstore As String = String.Empty
Dim Pathcode As String = String.Empty
With New StreamReader("C:\VB Test\location.txt")
Pathstore = .ReadLine()
.Dispose()
End With
' Are you sure this is the correct file ?
With New StreamReader("C:\VB Test\rmmsiul.dll")
Pathcode = .ReadLine()
.Dispose()
End With
' Capture the list of Attachment Files here, then use it twice below
Dim Attachments() As String = Directory.GetFiles("C:\VB Test\Receipts")
Dim e_mail As New Net.Mail.MailMessage()
With e_mail
.From = New Net.Mail.MailAddress("Do-Not-Reply#suncommobile.com")
.Subject = String.Format("{0} Manual reciepts", Pathstore)
.Body = String.Format("Here are the manual reciepts I created today.{0}{0}{0}Thank you,{0}{1}", Environment.NewLine, Pathstore)
' Since I don't know what Filter() returns, this is best guess to reproduce the same outcome
For Each line As String In Filter(File.ReadAllLines("C:\VB Test\stores.txt"), Pathstore)
Dim fields() As String = line.Split(",")
.CC.Clear()
.CC.Add(fields(4))
.CC.Add(fields(2))
.CC.Add(fields(6))
Next
For Each filepath In Attachments
.Attachments.Add(New Net.Mail.Attachment(filepath))
Next
End With
With New Net.Mail.SmtpClient
.Host = "smtp.office365.com"
.Credentials = New Net.NetworkCredential("Do-Not-Reply#suncommobile.com", Pathcode)
.Port = 587
.EnableSsl = True
.Send(e_mail)
End With
' Dispose the MailMessage to release the holds on the Attachment Files
e_mail.Dispose()
' Delete the Attachment Files
For Each filepath In Attachments
File.Delete(filepath)
Next
MsgBox("E-mail Sent.")
End Sub

Crystal Reports Missing Parameter Values

I am running the version of crystal that comes with Visual Studio 2010. I have a report that has three sub reports. There are parameters that are passed from the main report to the sub-reports. I am able to run the report in the development environment by clicking on Main Report Preview.
The problem is when I try to execute it at run time. I get the error “Missing parameter values”. I need some hints as to how to debug this problem. The error doesn’t tell you which parameter is the problem or which sub-report is involved.
Any hint will be appreciated.
I am editing this to respond to some of the questions. I am using subreports links which is where I think the problem might be. In the pass by fiddling with the settings I was able to get it to work. It seems like it was just trial and error.
I am posting a portion of the code here based on the request in the comments
Public Function GetReportOutput(iDatabaseIndicator As eDatabaseIndicatorEnum, ReportName As String, ReportOutputtype As eReportOutputtype, ReportParameters As System.Collections.Generic.List(Of clsReportParam)) As clsReturn Implements IsvcEDReports.GetReportOutput
Dim l_crRep As New CrystalDecisions.CrystalReports.Engine.ReportDocument
Dim l_clsReturn As clsReturn = New clsReturn
Dim l_ExportFormatType As ExportFormatType
Dim l_strReport As String = ""
Dim l_strReportName As String = ""
Dim l_strOutputFile As String = ""
Dim l_strFullPathName As String = ""
Dim l_strReportOutputPath As String = ConfigurationManager.AppSettings.Get(IIf(ConfigurationManager.AppSettings.Get("Environment") = 1, "ReportOutputPath_Dev", "ReportOutputPath_Prod"))
Dim l_strReportPath As String = ConfigurationManager.AppSettings.Get(IIf(ConfigurationManager.AppSettings.Get("Environment") = 1, "ReportPath_Dev", "ReportPath_Prod"))
Dim l_udtReport As CrystalDecisions.CrystalReports.Engine.ReportDocument = Nothing
Dim l_intCount As Integer = 0
Dim l_fsReturn As FileStream = Nothing
Dim l_binFilestream As BinaryReader = Nothing
Dim l_bytFile As Byte() = Nothing
Dim l_expOptions As New CrystalDecisions.Shared.ExportOptions
Dim l_expExcFmtOptions As New CrystalDecisions.Shared.ExcelFormatOptions
Dim l_tblParameters As New DataTable("Parameters")
Dim l_aryParams(1)
Dim udtSubReport As ReportDocument
Dim udtSubReportOpened As ReportDocument
Try
iDatabaseIndicator = iDatabaseIndicator
InitDataController(iDatabaseIndicator)
m_strReport = (l_strReportPath & "\" & ReportName)
l_strReportName = ReportName
l_strReport = m_strReport
l_strOutputFile = Regex.Replace(ReportName, " ", "_") & "_" & Format(Now(), "MMddyyyy_hhmmss")
m_strOutputFilename = l_strOutputFile
With l_crRep
.Load(l_strReport, CrystalDecisions.Shared.OpenReportMethod.OpenReportByDefault)
If .IsLoaded Then
For Each udtSubReport In .Subreports
udtSubReportOpened = .OpenSubreport(udtSubReport.Name)
SetDatabase(udtSubReportOpened, False)
SetParameters(udtSubReportOpened, ReportParameters, False)
Next
SetDatabase(l_crRep)
SetParameters(l_crRep, ReportParameters)
Select Case ReportOutputtype
'Case eReportOutputtype.rptOutputType_RPT
' l_strOutputFile = l_strOutputFile & ".rpt"
' l_ExportFormatType = ExportFormatType.CrystalReport
Case eReportOutputtype.rptOutputType_XLS
l_strOutputFile = l_strOutputFile & ".xls"
'ReportOutputFile = ReportOutputFile & ".xls"
With l_expExcFmtOptions
.ExcelConstantColumnWidth = 125
.ExcelUseConstantColumnWidth = True
End With
With l_expOptions
.ExportFormatOptions = l_expExcFmtOptions
End With
l_ExportFormatType = ExportFormatType.Excel
Case eReportOutputtype.rptOutputType_PDF
l_strOutputFile = l_strOutputFile & ".pdf"
' ReportOutputFile = ReportOutputFile & ".pdf"
l_ExportFormatType = ExportFormatType.PortableDocFormat
Case eReportOutputtype.rptOutputType_DOC
l_strOutputFile = l_strOutputFile & ".doc"
' ReportOutputFile = ReportOutputFile & ".doc"
l_ExportFormatType = ExportFormatType.WordForWindows
Case eReportOutputtype.rptOutputType_CSV
l_strOutputFile = l_strOutputFile & ".csv"
' ReportOutputFile = ReportOutputFile & ".csv"
l_ExportFormatType = ExportFormatType.CharacterSeparatedValues
Case eReportOutputtype.rptOutputType_TXT
l_strOutputFile = l_strOutputFile & ".txt"
' ReportOutputFile = ReportOutputFile & ".txt"
l_ExportFormatType = ExportFormatType.Text
Case eReportOutputtype.rptOutputType_XML
l_strOutputFile = l_strOutputFile & ".xml"
' ReportOutputFile = ReportOutputFile & ".xml"
l_ExportFormatType = ExportFormatType.Xml
End Select
.ExportToDisk(l_ExportFormatType, l_strReportOutputPath & "\" & l_strOutputFile)
It crashes on the last line .ExportToDisk ...
I solved this problem, It was the hint from heringer that gave me the clue. I am passing 6 parameters to the main report but two of them are only used by the a sub-report not the main reports itself. I was defining these without the leading "#". I figured this out by display the parameters as I passed them in my code.
I was also able to look at an old report that was working and saw that I needed the at signs.
Bob

Google-maps loads different location from marker

My Google-maps api loads the map on the Atlantic-Ocean whilest my markers are pointed somewhere else.
I have checked my code, the lat and long coordinates are correct and they are marked on the map.
Can anybody help me out on this one?
Dim GeoLatitude As Double
Dim GeoLongitude As Double
Dim GoogleGeoCoderKey As String = keyvar
Dim GoogleResult1 As GoogleResult
GoogleResult1 = GoogleGeocoder.Geocode("streetname, PC City", GoogleGeoCoderKey) 'CurrentPage.PageName & " " & CurrentPage.BodyLeft
If GoogleResult1.Status = GeocodeStatus.G_GEO_SUCCESS Then
If GoogleResult1.Locations.Count = 1 Then
For Each loc As Location In GoogleResult1.Locations()
Dim latOld As String = loc.Point.Latitude.ToString()
GeoLatitude = loc.Point.Latitude ' latOld.Replace(",", ".")
Dim lonOld As String = loc.Point.Longitude.ToString()
GeoLongitude = loc.Point.Longitude 'lonOld.Replace(",", ".")
Next
End If
End If
GoogleMap1.Width = 628
GoogleMap1.Height = 300
GoogleMap1.GoogleKey = keyvar
GoogleMap1.Latitude = GeoLatitude
GoogleMap1.Longitude = GeoLongitude
GoogleMap1.Zoom = 15
GoogleMap1.Options.MapTypes.Add(New Reimers.Map.CustomMaps.GoogleNormalMap())
Dim tm As New Reimers.Map.CustomMaps.GoogleNormalMap()
GoogleMap1.DefaultMap() = tm
GoogleMap1.MapControls.Clear()
GoogleMap1.MapControls.Add(New Reimers.Map.Controls.GoogleLargeMapControl("smc"))
If SubPagePartValue.SmallText1 <> "" And SubPagePartValue.SmallText2 <> "" Then
GeoLatitude = CDbl(SubPagePartValue.SmallText1)
GeoLongitude = CDbl(SubPagePartValue.SmallText2)
End If
If GeoLatitude = 0 Or GeoLongitude = 0 Then
GoogleResult1 = GoogleGeocoder.Geocode(SubPages.BodyLeft, GoogleGeoCoderKey)
If GoogleResult1.Status = GeocodeStatus.G_GEO_SUCCESS Then
If GoogleResult1.Locations.Count = 1 Then
For Each loc As Location In GoogleResult1.Locations()
Dim latOld As String = loc.Point.Latitude.ToString()
GeoLatitude = loc.Point.Latitude
Dim lonOld As String = loc.Point.Longitude.ToString()
GeoLongitude = loc.Point.Longitude
SubPagePartValue.SmallText1 = GeoLatitude
SubPagePartValue.SmallText2 = GeoLongitude
SubPagePartValue.Save()
Next
End If
End If
End If
Dim HTMLCode As String
Dim gm As GoogleMarker = New GoogleMarker(SubPages.PageID)
gm.Point.Latitude = GeoLatitude
gm.Point.Longitude = GeoLongitude
HTMLCode = "<div class=""GoogleMapsPopUp""><h1 class=""GoogleMapsPopUp"">" & SubPages.PageName & "</h1>"
HTMLCode = HTMLCode & "<p class=""text"">" & SubPages.PageName & "</p><p>" & SubPages.BodyLeft & "</p></div>"
gm.MarkerText = HTMLCode
gm.ClientSideHandlers.OnInfoWindowOpen = GoogleMap1.PanTo(gm.Point)
gm.ClientSideHandlers.OnClick = gm.OpenInfoWindowHTML(GoogleMap1, gm.MarkerText)
'gm.Options.Icon = SailpointIcon
gm.Options.Title = Replace(SubPages.PageName, "'", "")
GoogleMap1.Overlays.Add(gm)
End If
Next
the actual result can be viewed on the following site: http://www.stripdagenhaarlem.nl/Programma-Stripdagen-Haarlem.html?cb=T If you zoom out on the maps you would see that the markers are placed correct. However, the map keeps zooming on the wrong location.
Try and load your variables to make the code look like
<html xmlns=http://www.w3.org/1999/xhtml><head><meta http-equiv=Content-Type content=text/html; charset=utf-8 /><body topmargin=0 leftmargin=0 ><iframe width=574 height=275 frameborder=0 scrolling=no marginheight=0 marginwidth=0 src=https://maps.google.com/maps?hl=en&ie=UTF8&ll=" & GLLat & "," & GLLong & "&spn=0.819443,1.454315&t=h&z=18&output=embed></iframe></body></html>
Make sure scrolling=no and z=18, z is the zoom where it initially starts out at
You will have to piece your variables together yourself :P
hope this helps

Add a Parameter Value in SSRS

I have a report already setup on the ReportServer. And its subscription as well. What I'm trying to do is add the ParameterValue "CC" and some email addresses then send the email out. It doesn't seem to work.
My code:
Dim emailReader As SqlDataReader = selCount.ExecuteReader
Dim emailsTest As List(Of String) = New List(Of String)
emailsTest.Add("test1#pen.com")
emailsTest.Add("test2#pen.com")
emailsTest.Add("test3#pen.com")
emailsTest.Add("test4#pen.com")
If emailReader.HasRows() Then 'checks to see if there any quotes in query
For Each subscrp As rs.Subscription In subscr
Dim allValues = subscrp.DeliverySettings.ParameterValues
Dim allValuesList As List(Of ReportTriggerTemplate1.rs.ParameterValueOrFieldReference) = allValues.ToList()
Dim CCParameter As ReportTriggerTemplate1.rs.ParameterValue = New ReportTriggerTemplate1.rs.ParameterValue()
CCParameter.Name = "CC"
CCParameter.Value = String.Empty
allValuesList.Add(CCParameter)
Dim toValue = CType(allValuesList.Item(7), ReportTriggerTemplate1.rs.ParameterValue)
For Each testEmail As String In emailsTest
Dim ownerEmail As String = testEmail
If toValue.Value.Contains(ownerEmail) Then
'skip
ElseIf toValue.Value = String.Empty Then
toValue.Value += ownerEmail
Else
toValue.Value += "; " & ownerEmail
End If
Next
subscrp.DeliverySettings.ParameterValues = allValuesList.ToArray()
Dim hello As String = "hi"
tr.FireEvent(EventType, subscrp.SubscriptionID) 'forces subscription to be sent
Next
What I'm adding to toValue.Value doesn't seem to be adding to the report's CC subscription field at all. So what am I missing?
http://msdn.microsoft.com/en-us/library/ms154020%28v=SQL.100%29.aspx
http://msdn.microsoft.com/en-us/library/reportservice2005.reportingservice2005.getsubscriptionproperties.aspx
http://msdn.microsoft.com/en-us/library/reportservice2005.reportingservice2005.setsubscriptionproperties%28v=SQL.105%29.aspx
Try
tr = New rs.ReportingService2005
Dim extSettings As ExtensionSettings = Nothing
Dim desc As String = Nothing
Dim active As ActiveState = Nothing
Dim status As String = Nothing
Dim matchData As String = Nothing
Dim values As ParameterValue() = Nothing
Dim extensionParams As ParameterValueOrFieldReference() = Nothing
Dim mainLogin As System.Net.NetworkCredential = New System.Net.NetworkCredential("ADUser", "Password", "NetworkName")
If mainLogin Is Nothing Then
tr.Credentials = System.Net.CredentialCache.DefaultCredentials
Else
tr.Credentials = mainLogin
End If
'skip to relevant code
For Each subscrp As rs.Subscription In subscr
Dim allValues = subscrp.DeliverySettings.ParameterValues
Dim allValuesList As List(Of ReportTriggerTemplate1.rs.ParameterValueOrFieldReference) = allValues.ToList()
If CType(allValuesList.Item(0), ReportTriggerTemplate1.rs.ParameterValue).Value = "test#pen.com" Then
Dim subsID = subscrp.SubscriptionID
'important code just below
tr.GetSubscriptionProperties(subsID, extSettings, desc, active, status, EventType, matchData, extensionParams)
''''add change to CC here
Dim extSettingsList As List(Of ReportTriggerTemplate1.rs.ParameterValueOrFieldReference) = extSettings.ParameterValues.ToList()
If CType(extSettingsList.Item(1), ReportTriggerTemplate1.rs.ParameterValue).Name = "CC" Then
If CType(extSettingsList.Item(1), ReportTriggerTemplate1.rs.ParameterValue).Value = String.Empty Then
CType(extSettingsList.Item(1), ReportTriggerTemplate1.rs.ParameterValue).Value = emailsTest.Item(0) & ";" & emailsTest.Item(1)
Else
CType(extSettingsList.Item(1), ReportTriggerTemplate1.rs.ParameterValue).Value += ";" & emailsTest.Item(0) & ";" & emailsTest.Item(1)
End If
Else
Dim CCParameter As ReportTriggerTemplate1.rs.ParameterValue = New ReportTriggerTemplate1.rs.ParameterValue()
CCParameter.Name = "CC"
CCParameter.Value = emailsTest.Item(0) & ";" & emailsTest.Item(1)
extSettingsList.Insert(1, CCParameter)
extSettings.ParameterValues = extSettingsList.ToArray
End If
'important code just below
tr.SetSubscriptionProperties(subsID, extSettings, desc, EventType, matchData, extensionParams)
tr.FireEvent(EventType, subscrp.SubscriptionID) 'forces subscription to be sent
Else
End If
Next