お世話になります。
現在、VB2008でメールソフトを作っているのですが、
いざメールを送信すると、メールが届いたり、届かなかったりというトラブルが発生しております。
送信者のメールアドレスが受信者側で迷惑メールとして設定されている訳ではありません。
メールは正常に送信できたと記録されております。
また、同じ宛先で届いたり届かなかったりしております。
宜しくお願い致します。
ソースは下記の通りです。
VB.NET
1 'メールを送信する 2 'SendMail関数を呼んでメールを送信します。 3 'BSMTP.DLLをWindowsのsystem32ディレクトリにコピーします。 4 ' 5 Dim ret As String 6 Dim szLogfile As String 7 Dim szServer As String, szTo As String, szFrom As String 8 Dim szSubject As String, szBody As String, szFile As String 9 Dim result As Integer 10 Dim タイトル As String 11 Dim 内容1 As String 12 Dim 内容2 As String 13 Dim 内容3 As String 14 Dim 内容4 As String 15 Dim 内容5 As String 16 Dim 内容6 As String 17 Dim 内容7 As String 18 Dim 内容8 As String 19 Dim 内容9 As String 20 Dim 内容10 As String 21 Dim 情報 As String 22 Dim 文面 As String 23 Dim account As String 24 Dim naiyo As String 25 Dim t_naiyo As String 26 Dim アドレス As String 27 Dim cnt As Integer 28 Dim str_n As Long 29 Dim strSQL As String 30 Dim Rows As DataRow() 31 Dim i As Integer = -1 32 Dim intCnt As Integer 33 Dim bobj As Object 34 bobj = CreateObject("basp21") 35 36 Dim f As New progress 37 f.Owner = Me 38 f.Show() 39 ' 時間のかかる処理 40 Dim ix As Integer 41 For ix = 0 To 20 42 ' メッセージ・キューにあるWindowsメッセージをすべて処理する 43 Me.Activate() 44 Application.DoEvents() 45 ' 何らかの処理 46 System.Threading.Thread.Sleep(100) 47 48 ' メッセージ・キューにあるWindowsメッセージをすべて処理する 49 Application.DoEvents() 50 Next 51 'メール送信結果を記録するファイル名の取得 52 szLogfile = Trim(Me.LogF.Text) 53 'SMTPサーバー 54 szServer = Trim(Me.MailServer.Text) & ":587" 55 'アカウント 56 account = Trim(Me.Acount.Text) 57 '送信元 58 szFrom = Trim(Me.SenderMail.Text) & vbTab & account & vbTab & "LOGIN" '"CRAM-MD5" '"LOGIN" '"PLAIN" 59 60 strSQL = "" 61 strSQL &= "DELETE QR_SendMailKeep" & vbCrLf 62 mclsDBAcc.ExecuteSQL(strSQL) 63 64 strSQL = "" 65 strSQL &= "SELECT * " & vbCrLf 66 strSQL &= " FROM QR_MemberEntry" & vbCrLf 67 Rows = mclsDBAcc.GetRows(strSQL) 68 69 If Rows Is Nothing = True Then 70 f.Hide() 71 result = MsgBox("再度CSVを取得してください。", vbOKOnly, "確認") 72 Me.Close() 73 End If 74 75 If Me.RBtnOwner.Checked = True Then 76 タイトル = Trim(Me.CmbTitle.Text) 77 文面 = Trim(Me.TxtMailDoc.Text) 78 79 strSQL = "" 80 strSQL &= "SELECT * " & vbCrLf 81 strSQL &= " FROM QR_MemberEntry Where Owner <> ''" & vbCrLf 82 Rows = mclsDBAcc.GetRows(strSQL) 83 84 If Rows Is Nothing = True Then 85 f.Hide() 86 result = MsgBox("送信データがありません。", vbOKOnly, "確認") 87 data_0 = 1 88 Exit Function 89 End If 90 End If 91 If Me.RBtnPet.Checked = True Then 92 タイトル = Trim(Me.CmbTitle1.Text) 93 文面 = Trim(Me.TxtMailDoc1.Text) 94 strSQL = "" 95 strSQL &= "SELECT * " & vbCrLf 96 strSQL &= " FROM QR_MemberEntry Where Name <> ''" & vbCrLf 97 Rows = mclsDBAcc.GetRows(strSQL) 98 99 If Rows Is Nothing = True Then 100 f.Hide() 101 result = MsgBox("送信データがありません。", vbOKOnly, "確認") 102 data_0 = 1 103 Exit Function 104 End If 105 End If 106 If Me.RBtnOwnPet.Checked = True Then 107 タイトル = Trim(Me.CmbTitle.Text) & "及び" & Trim(Me.CmbTitle1.Text) 108 t_naiyo = Trim(Me.TxtMailDoc.Text) 109 文面 = Trim(Me.TxtMailDoc1.Text) 110 strSQL = "" 111 strSQL &= "SELECT * " & vbCrLf 112 strSQL &= " FROM QR_MemberEntry Where Owner <> ''" & vbCrLf 113 Rows = mclsDBAcc.GetRows(strSQL) 114 115 If Rows Is Nothing = True Then 116 f.Hide() 117 result = MsgBox("送信データがありません。", vbOKOnly, "確認") 118 data_0 = 1 119 Exit Function 120 End If 121 strSQL = "" 122 strSQL &= "SELECT * " & vbCrLf 123 strSQL &= " FROM QR_MemberEntry Where Name <> ''" & vbCrLf 124 Rows = mclsDBAcc.GetRows(strSQL) 125 126 If Rows Is Nothing = True Then 127 f.Hide() 128 result = MsgBox("送信データがありません。", vbOKOnly, "確認") 129 data_0 = 1 130 Exit Function 131 End If 132 133 End If 134 135 件数 = 0 136 szFile = "" 137 cnt = 1 138 139 strSQL = "" 140 strSQL &= "SELECT * " & vbCrLf 141 strSQL &= " FROM QR_Info" & vbCrLf 142 Rows = mclsDBAcc.GetRows(strSQL) 143 144 If Me.CBAttach.Checked = True Then 145 146 If Rows Is Nothing = True Then 147 f.Hide() 148 result = MsgBox("送信データがありません。", vbOKOnly, "確認") 149 data_0 = 1 150 Exit Function 151 Else 152 情報 = Rows(0)("Info") 153 End If 154 Else 155 情報 = "" 156 End If 157 158 159 160 strSQL = "" 161 strSQL &= "SELECT MailAddress,MAX(Owner) as Owner " & vbCrLf 162 strSQL &= " FROM QR_MemberEntry WHERE SendZero = 0 Group By MailAddress" & vbCrLf 163 Rows = mclsDBAcc.GetRows(strSQL) 164 165 If Rows Is Nothing = True Then 166 f.Hide() 167 result = MsgBox("送信データがありません。", vbOKOnly, "確認") 168 data_0 = 1 169 Exit Function 170 End If 171 172 Try 173 For intCnt = 0 To Rows.Length - 1 174 i = i + 1 175 If Me.CBAttach.Checked = True Then 176 内容1 = "◇" & Rows(intCnt).Item("Owner") & "様" & Chr(13) & Chr(10) 177 178 szSubject = タイトル 179 szBody = 内容1 & Chr(13) & Chr(10) _ 180 & Chr(13) & Chr(10) _ 181 & 文面 & Chr(13) & Chr(10) _ 182 & Chr(13) & Chr(10) 183 184 szTo = Rows(intCnt).Item("MailAddress") 185 szBody = szBody & Chr(13) & Chr(10) _ 186 & 情報 & Chr(13) & Chr(10) 187 Else 188 内容1 = "◇" & Rows(intCnt).Item("Owner") & "様" & Chr(13) & Chr(10) 189 190 szSubject = タイトル 191 szBody = 内容1 & Chr(13) & Chr(10) _ 192 & Chr(13) & Chr(10) _ 193 & 文面 & Chr(13) & Chr(10) _ 194 & Chr(13) & Chr(10) 195 196 szTo = Rows(intCnt).Item("MailAddress") 197 szBody = szBody & Chr(13) & Chr(10) _ 198 & Chr(13) & Chr(10) 199 200 End If 201 202 strSQL = "" 203 strSQL = " INSERT INTO " & vbCrLf 204 strSQL &= "[a_animal].[dbo].[QR_SendMailKeep]" 205 strSQL &= " ( " & vbCrLf 206 strSQL &= " " & "Till" & vbCrLf 207 strSQL &= " , " & "Subject" & vbCrLf 208 strSQL &= " , " & "Body" & vbCrLf 209 strSQL &= " ) " & vbCrLf 210 strSQL &= " VALUES" & vbCrLf 211 strSQL &= " ( " & vbCrLf 212 strSQL &= " " & "'" & szTo & "'" & vbCrLf 213 strSQL &= " , " & "'" & szSubject & "'" & vbCrLf 214 strSQL &= " , " & "'" & szBody & "'" & vbCrLf 215 strSQL &= " ) " & vbCrLf 216 mclsDBAcc.ExecuteSQL(strSQL) 217 218 '送信処理 219 ret = bobj.SendMailEx(szLogfile, szServer, szTo, szFrom, szSubject, szBody, szFile) 220 件数 = 件数 + 1 221 Next 222 ' 送信エラーのときは、戻り値にエラーメッセージが返ります。 223 If 件数 = 0 Then 224 f.Hide() 225 result = MsgBox("送信データがありません。", vbOKOnly, "確認") 226 data_0 = 1 227 Else 228 f.Hide() 229 result = MsgBox(件数 & "件 送信しました", vbOKOnly, "確認") 230 End If 231 232 Catch ex As Exception 233 ' 例外が発生した時の処理 234 Throw New Exception(ex.ToString) 235 Finally 236 End Try 237 238
回答1件
あなたの回答
tips
プレビュー