Мы используем SQL в Access, чтобы проверить, ведутся ли данные в разных системах ERP.
Для проверки создается таблица, которая оценивает столбцы данных как «выполнено» или «пропущено».Строки с «отсутствующими» экспортируются через VBA в виде электронных писем Outlook, адресованных ответственному персоналу.
Код берет строки продуктов с «отсутствующими» и помещает их в тело экспорта почты.
Проблема:
Экспортированная таблица должна отображать всю информацию в ячейках таблицы в Access.Некоторые экспортированные электронные письма содержат все значения ячеек, некоторые электронные письма содержат пропущенные значения в таблице.
Как настроить код так, чтобы отображались все ячейки в таблице?
Изображения
Таблица доступа
Правильный экспорт электронной почты
НеверноЭкспорт таблицы
Private Sub CopyToAnotherMasterDataTracking_Click()
Dim emaildata As Date
emaildata = Format(Date, "yyyy-mm-dd")
DoCmd.RunSQL "select * into [" & emaildata & "-Table_MASTERDATA] from Table_MASTERDATA"
DoCmd.RunSQL "update [" & emaildata & "-Table_MASTERDATA] set [Pre_Launch_Release]='Missing' where [Pre_Launch_Release] <> 'Done'"
Dim str(30) As String
Dim no As Integer
Dim rst As Recordset
Set rst = CurrentDb.OpenRecordset("Table_MASTERDATA")
i = 0 'i - Number of rows in MasterData Table (or count column?)
For i = 0 To rst.Fields.Count - 1
fldName = rst.Fields(i).Name
str(i) = rst.Fields(i).Name
Next
rst.MoveFirst
step = 4
strsql = "SELECT * FROM Table_MASTERDATA"
Set rec = CurrentDb.OpenRecordset(strsql)
rec.MoveFirst
no = 1 'Row number
Do Until rec.EOF
DoneOrMissing = ""
flag = 1
For i = 0 To 21 'Column No
If flag = 1 Then
If rec.Fields(i).Value <> "" Then
DoneOrMissing = rec.Fields(i).Value
Else
DoneOrMissing = ""
End If
If DoneOrMissing = "Done" Then
DoCmd.SetWarnings False
DoCmd.RunSQL "update [" & emaildata & "-Table_MASTERDATA] set [" & rst.Fields(i).Name & "]=0 where [NO]=" & rec.Fields(10).Value
ElseIf DoneOrMissing = "Missing" Then
DoCmd.SetWarnings False
DoCmd.RunSQL "update [" & emaildata & "-Table_MASTERDATA] set [" & rst.Fields(i).Name & "]=#" & emaildata & "# where [NO]=" & rec.Fields(10).Value
step = 5
If i = 8 Then
step = 1 'prelaunch
flag = 1
ElseIf i = 13 Then 'SMM
step = 1
flag = 0
ElseIf i = 14 Then 'PPT comm
step = 2
flag = 0
ElseIf i > 14 And i < 21 Then 'netween P13_MD04 and FC in system / actuall tasks of P13
step = 3
flag = 1
End If
Else
flag = 1
End If
End If
Next
flag = 1
rec.MoveNext
no = no + 1
Loop
If step = 4 Then 'Means that it is done (for instance SMM is done)
End If
DoCmd.SetWarnings True
rst.Close
MsgBox "You have created the record successfully!Please go to next step"
End Sub
'--------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------
Private Sub RemindEmails_Click()
Dim strsql As String
Dim trsql As String
Dim Emailaddress1 As String
Dim Emailaddress2 As String
Dim DoneOrMissing As String
Dim fontbgcolor As String
Dim flag As Integer
Dim subject As String
Dim step As Integer
'----------------------------------------------------------------
'flag judge the part 1 or 2 or 3 's missing record stop or full
'step judge the subject and the remindmessage
'----------------------------------------------------------------
subject = ""
Dim str(30) As String
Dim i As Integer
Dim MyMessage1 As Object
Dim EmailBody1 As String
Dim RemindMessage As String
Dim rst As Recordset
Set rst = CurrentDb.OpenRecordset("Table_MASTERDATA")
Dim rst2 As Recordset
Set rst2 = CurrentDb.OpenRecordset("Query_name") 'Query_Name: Email Address list
i = 0
For i = 0 To rst.Fields.Count - 1
str(i) = rst.Fields(i).Name
Next
rst.MoveFirst
rst2.MoveFirst
Do Until rst2.EOF
A = rst2![Name]
step = 5
EmailBody1 = "<TABLE border='1' border-bottom: ''1px solid #000'' cellspacing=""1"" cellpadding=""1"" style=""border-collapse:collapse;"">" & "<TR>"
For i = 0 To 20
EmailBody1 = EmailBody1 & "<Th nowrap Bgcolor=""#08427e"", Align=""Center""><Font Color=#FCDFFF><b><p style=""font-size:12px"">" & str(i) & " </p></Font></Th>"
Next
strsql = "SELECT * FROM Table_MASTERDATA WHERE Name='" + A + "'"
Set rec = CurrentDb.OpenRecordset(strsql)
rec.MoveFirst
Do Until rec.EOF
fontbgcolor = "white"
DoneOrMissing = ""
flag = 1
dmflag = 1
EmailBody1 = EmailBody1 & "<TR>"
For i = 0 To 20
If flag = 1 Then
If rec.Fields(i).Value <> "" Then
DoneOrMissing = rec.Fields(i).Value
End If
If DoneOrMissing = "Done" Then
EmailBody1 = EmailBody1 & "<TD nowrap Bgcolor=""#00b050"" ><center><Font Color=#FFFFFF><b><p style=""font-size:12px"">" & rec.Fields(i).Value & "</font></TD>"
ElseIf DoneOrMissing = "Missing" Then
If i <> 20 Then
EmailBody1 = EmailBody1 & "<TD nowrap Bgcolor=""#EE2C2C""><center><Font Color=#FFFFFF><b><p style=""font-size:12px"">" & rec.Fields(i).Value & "</FONT></TD>"
End If
step = 6
If i = 8 Then 'PreLaunchRelease
step = 1
flag = 0
ElseIf i = 12 Then 'P13_Activation
step = 1
flag = 0
RemindMessage = "Dear " & A & "," & "<br /><br />" & "Please support on P13 activation. If you have questions please contact the respective PuT from the Table below. Thanks!" & "<br /><br />" & "BR" & "<br /><br />" & "Yashar Alexander Hooshyar (PT-BE/LOI)"
subject = "P13 activation" 'to PJM
ElseIf i = 13 Then 'SMM_table !!!!!!!!!!!!!! New Source-> if pprevious steps are done, then Step SMM must be Quality Gate
step = 1
flag = 0
If rec.Fields(8).Value = "Done" Then
Debug.Print rec.Fields(8).Value
RemindMessage = "Dear " & A & "," & "<br /><br />" & "Please be kindly noted, below items SMM master data has missing part with red mark, please help maintain it ASAP. If you have questions please contact the respective PuT from the Table below. Thanks!" & "<br /><br />" & "BR" & "<br /><br />" & "Yashar Alexander Hooshyar (PT-BE/LOI)"
subject = "SMM master data maintain request"
' Else 'delete this case
' Debug.Print rec.Fields(8).Value
' RemindMessage = "Dear " & A & "," & "<br /><br />" & "Please be kindly noted, below items are ready for FCST uploading, please help upload it ASAP. Thanks!" & "<br /><br />" & "BR" & "<br /><br />" & "Miduo"
' subject = "Pronovia mantain request" ' to PJM
End If
' ElseIf i = 14 Then 'PPT_Comm.
' step = 2
' flag = 0
' RemindMessage = "Dear " & A & "," & "<br /><br />" & "Please be kindly noted, below items PPT commodity code is missing, please help maintain it ASAP. Thanks!" & "<br /><br />" & "BR" & "<br /><br />" & "Miduo"
' subject = "Pronovia mantain request" 'to PJM
ElseIf i > 13 And i < 19 Then
step = 3
flag = 1
dmflag = 0
RemindMessage = "Dear " & A & "," & "<br /><br />" & "Please be kindly noted, below items P13 master data has missing part with red mark, please help maintain it ASAP. If you have questions please contact the respective PuT from the Table below. Thanks!" & "<br /><br />" & "BR" & "<br /><br />" & "Yashar Alexander Hooshyar (PT-BE/LOI)"
subject = "P13 master data maintain request"
If i = 18 Then flag = 0
'2017/10/25 add new dm and change the email layout
ElseIf i = 19 And dmflag = 1 Then
step = 4
flag = 0
dmflag = 0
RemindMessage = "Dear " & A & "," & "<br /><br />" & "Please be kindly noted, below items P13 master data has missing part with red mark, please help maintain it ASAP. If you have questions please contact the respective PuT from the Table below. Thanks!" & "<br /><br />" & "BR" & "<br /><br />" & "Yashar Alexander Hooshyar (PT-BE/LOI)"
subject = "P13 master data maintain request"
ElseIf i = 20 And dmflag = 1 Then
EmailBody1 = EmailBody1 & "<TD nowrap Bgcolor=""#EE2C2C""><Font Color=#FFFFFF><center><b><p style=""font-size:12px"">" & rec.Fields(i).Value & "</Font></TD>"
RemindMessage = "Dear " & A & "," & "<br /><br />" & "Please be kindly noted, below items are ready for FCST uploading, please help upload it ASAP. If you have questions please contact the respective PuT from the Table below. Thanks!" & "<br />Thanks!<br /><br />" & "BR" & "<br /><br />" & "Yashar Alexander Hooshyar (PT-BE/LOI)"
'RemindMessage = "Hello nnnnnnn," & "<br /><br />" & "Please be kindly noted below new products SKU has been activated in P13, please help upload ramp up plan into system. Thanks!" & "<br /><br />" & "BR" & "<br /><br />" & "Miduo"
subject = "Please upload ramp up plan for new launch products"
End If
Else
EmailBody1 = EmailBody1 & "<TD nowrap><center><nobr><p style=""font-size:12px"">" & rec.Fields(i).Value & "</nobr></TD>"
End If
End If
Next
flag = 1
EmailBody1 = EmailBody1 & "</TR>"
rec.MoveNext
Loop
Set MyOutlook1 = CreateObject("Outlook.Application")
Set MyMessage1 = MyOutlook1.CreateItem(0)
trsql = "SELECT Email FROM Table_MASTERDATA WHERE Name = '" + A + "'"
Set r = CurrentDb.OpenRecordset(trsql)
Emailaddress1 = r.Fields("Email")
[....]
Код экспорта нескольких электронных писем, адресованных разным людям и разным текстам.
Некоторые таблицы в экспорте электронных писем содержат все значения ячеек, некоторые таблицы имеют пустые ячейки.
Цель состоит в том, чтобы все таблицы в электронных письмах содержали все значения ячеек.