在一个服装销售软件中,要将每天的销售额通过发邮件的形式提交到老板那里.
于是:1,提取每天销售及退货情况.
3.以导出的excel为附件进行邮件群发
关键代码如下:
导出为excel文件
Public Sub exportExcel(ByVal dgv As DataGridView)
Try
If dgv.RowCount = 0 Then
MessageBox.Show("列表中无数据，导出数据失败","提示")
Return
End If
'总列数
Dim columnCount As Integer = dgv.Columns.Count
'创建Excel对象
Dim excelApp As Microsoft.Office.Interop.Excel._Application = New ApplicationClass()
'新建工作簿
Dim workBook As Microsoft.Office.Interop.Excel._Workbook = excelApp.Workbooks.Add(True)
'新建工作表
Dim worksheet As Microsoft.Office.Interop.Excel._Worksheet = TryCast(workBook.ActiveSheet,Microsoft.Office.Interop.Excel._Worksheet)
'设置标题
Dim titleRange As Microsoft.Office.Interop.Excel.Range = worksheet.Range(worksheet.Cells(1,1),worksheet.Cells(1,columnCount))
'选取单元格
titleRange.Merge(True)
'合并单元格
titleRange.Value2 = "欧榜服饰(" & SPName & ")"
'设置单元格内容
titleRange.Font.Name = "黑体"
'设置字体
'titleRange.Font.Color = Color.Red;//设置字体颜色
titleRange.Font.Size = 20
'设置字体大小
titleRange.Font.Bold = True
'字体加粗
titleRange.HorizontalAlignment = XlHAlign.xlHAlignCenter
'水平居中
titleRange.VerticalAlignment = XlVAlign.xlVAlignCenter
'垂直居中
'titleRange.Borders.LineStyle = XlLineStyle.xlContinuous;//设置边框
'titleRange.Borders.Weight = XlBorderWeight.xlThin;//设置边框粗细
'设置表头
For i As Integer = 0 To columnCount - 1
Dim headRange As Range = TryCast(worksheet.Cells(2,i + 1),Range)
'获取表头单元格
headRange.Value2 = dgv.Columns(i).HeaderText
'设置单元格文本
headRange.Font.Name = "宋体"
'设置字体
headRange.Font.Size = 14
'字体大小
headRange.Font.Bold = True
'加粗显示
headRange.HorizontalAlignment = XlHAlign.xlHAlignCenter
'水平居中
headRange.VerticalAlignment = XlVAlign.xlVAlignCenter
'垂直居中
'headRange.ColumnWidth = dataGridView1.Columns[i].Width / 7;//设置列宽
'headRange.EntireColumn.AutoFit();//自动调整列宽
headRange.Borders.LineStyle = XlLineStyle.xlContinuous
'设置边框
'设置边框粗细
headRange.Borders.Weight = XlBorderWeight.xlThin
Next
'填充数据
For i As Integer = 0 To dgv.Rows.Count - 1
For j As Integer = 0 To dgv.Columns.Count - 1
Dim contentRange As Range = TryCast(worksheet.Cells(i + 3,j + 1),Range)
'获取单元格
contentRange.EntireColumn.AutoFit()
'自动调整列宽
contentRange.RowHeight = 20
'设置行高
'If j = 6 Then
' contentRange.Value2 = dgv(j,i).Value.ToString
'Else
contentRange.Value2 = dgv(j,i).Value
'End If
'设置单元格文本
contentRange.Borders.LineStyle = XlLineStyle.xlContinuous
'设置边框
contentRange.Borders.Weight = XlBorderWeight.xlThin
'设置边框粗细
'自动换行
contentRange.WrapText = True
Next
Next
'加入合计行
Dim totalRange As Microsoft.Office.Interop.Excel.Range = worksheet.Range(worksheet.Cells(dgv.Rows.Count + 3,worksheet.Cells(dgv.Rows.Count + 3,columnCount))
'Dim totalRange As Range = TryCast(worksheet.Cells(10,9),Range)
totalRange.Merge(True)
totalRange.Value = "合计: " & LblNum.Text & ": " & TxtPiece.Text & "条 " & LblPiece.Text & ": " & TxtAcount.Text & "件 " & LblQuan.Text & ": " & TxtQuan.Text & "元"
' totalRange.Font.Bold = True
totalRange.Borders.LineStyle = XlLineStyle.xlContinuous
'设置边框
totalRange.Borders.Weight = XlBorderWeight.xlThin
'设置边框粗细
'加入注意事项
Dim Remark1 As Microsoft.Office.Interop.Excel.Range = worksheet.Range(worksheet.Cells(dgv.Rows.Count + 4,worksheet.Cells(dgv.Rows.Count + 4,columnCount))
Remark1.Merge(True)
Remark1.Value = "注意:数量为负数则表示为顾客退货或换货!"
Remark1.Font.Bold = True
'设置每列格式
For i As Integer = 0 To dgv.Columns.Count - 1
If i = 6 Then
Exit For
End If
Dim range As Range = worksheet.Range(worksheet.Cells(3,worksheet.Cells(dgv.RowCount + 3,i + 1))
range.HorizontalAlignment = XlHAlign.xlHAlignLeft
'对齐方式
'格式化文本，单元格格式设置
range.NumberFormatLocal = "0"
Next
'保存导出的Excel
Dim fileName As String = TxtRoad.Text.Trim & "\" & DtpSendDay.Value.ToString("yyyyMMdd") & "销售日报表.xls"
workBook.SaveCopyAs(fileName)
workBook.Saved = True
'设置Excel是否可见
excelApp.Visible = False
excelApp.Quit()
Catch ex As Exception
MsgBox("导出信息过程出现异常,请关闭本程序并重新尝试!",MsgBoxStyle.Critical,"提示")
End Try
End Sub
Public Sub SendFEmail(ByVal mailHost As String,ByVal mailFrom As String,ByVal mailAccounts As String,ByVal mailPassword As String,ByVal mailSubject As String,ByVal mailBody As String,ByVal mailAttach As String)
Try
Dim client As New System.Net.Mail.SmtpClient
client.Host = mailHost
client.Port = 25
client.Credentials = New System.Net.NetworkCredential(mailAccounts,mailPassword)
Dim mailMessage As New System.Net.Mail.MailMessage()
mailMessage.From = New System.Net.Mail.MailAddress(mailFrom)
Dim mailTo As String
For i As Integer = 0 To DgvEmail.RowCount - 1
mailTo = IIf(IsDBNull(DgvEmail.Item(2,i).Value),"",DgvEmail.Item(2,i).Value)
If mailTo = "" Then
Exit For
End If
mailMessage.To.Add(mailTo)
Next
mailMessage.Subject = mailSubject
mailMessage.SubjectEncoding = System.Text.Encoding.GetEncoding(936)
mailMessage.Body = mailBody
mailMessage.BodyEncoding = System.Text.Encoding.GetEncoding(936)
mailMessage.IsBodyHtml = False
If Not (mailAttach Is Nothing OrElse mailAttach = String.Empty) Then
Dim data As New System.Net.Mail.Attachment(mailAttach,System.Net.Mime.MediaTypeNames.Application.Octet)
Dim disposition As System.Net.Mime.ContentDisposition
disposition = data.ContentDisposition
disposition.CreationDate = System.IO.File.GetCreationTime(mailAttach)
disposition.ModificationDate = System.IO.File.GetLastWriteTime(mailAttach)
disposition.ReadDate = System.IO.File.GetLastAccessTime(mailAttach)
mailMessage.Attachments.Add(data)
End If
client.Send(mailMessage)
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
操作ini文件:
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String,ByVal lpKeyName As String,ByVal lpDefault As String,ByVal lpReturnedString As String,ByVal nSize As Int32,ByVal lpFileName As String) As Int32 '写ini API函数 Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String,ByVal lpString As String,ByVal lpFileName As String) As Int32 '读取ini文件内容 Public Function GetINI(ByVal Section As String,ByVal AppName As String,ByVal FileName As String) As String Dim Str As String = LSet(Str,256) GetPrivateProfileString(Section,AppName,lpDefault,Str,Len(Str),FileName) Return Microsoft.VisualBasic.Left(Str,InStr(Str,Chr(0)) - 1) End Function '写ini文件操作 Public Function WriteINI(ByVal Section As String,ByVal FileName As String) As Long WriteINI = WritePrivateProfileString(Section,FileName) End Function