שמירת שאילתא באקסס
-
@one1010
אל תגלה לאף אחד... , בסוף הכנתי לך את הכל בכפית של כסף ממש.
תעדכן את הכתובות מייל במקומות המתאימים כמו שהדריכו אותך באשכול הסמוך.
הכנסתי גם את הקוד לשליחת מיילים משם, אז אם הוא כבר בקוד שלך, תמחק אותו, ותדביק את שלי.תמחק את השורות האלו
Private Sub FilterB_Click() On Error Resume Next UpDateView End Sub
ותדביק את כל זה
Private Sub FilterB_Click() On Error Resume Next UpDateView Dim strBodyText As String strBodyText = getBodyText(Me.Main.Form.RecordSource) & vbCrLf & vbCrLf strBodyText = strBodyText & getBodyText(Me.More.Form.RecordSource) & vbCrLf & vbCrLf strBodyText = strBodyText & getBodyText(Me.BB.Form.RecordSource) MsgBox Send(strBodyText) End Sub Function getBodyText(strSql As String) As String Dim rs As DAO.Recordset Dim i As Integer Dim strSeparator As String strSeparator = vbTab Set rs = CurrentDb.OpenRecordset(strSql) For i = 0 To rs.Fields.Count - 1 getBodyText = getBodyText & rs.Fields(i).Name & strSeparator Next i getBodyText = getBodyText & vbCrLf rs.MoveFirst Do While Not rs.EOF For i = 0 To rs.Fields.Count - 1 getBodyText = getBodyText & rs.Fields(i) & strSeparator Next i getBodyText = getBodyText & vbCrLf rs.MoveNext Loop rs.Clone rs.Close Set rs = Nothing End Function Public Function Send(strBodyText) Dim cdoConfig Dim msgOne Dim ErrStr Set cdoConfig = CreateObject("CDO.Configuration") With cdoConfig.Fields .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = 465 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "YourEmail@gmail.com" .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "YourPasswoed" .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 .Update End With Set msgOne = CreateObject("CDO.Message") Set msgOne.Configuration = cdoConfig msgOne.To = "To name <SendTo@gmail.com>" msgOne.From = "Your Name <YourEmail@gmail.com>" msgOne.Subject = "Subject" msgOne.TextBody = "TextBody" 'msgOne.AddAttachment "C:\Users\1\Downloads\Some File.pdf" msgOne.Send End Function
-
@one1010 זה ממש לא תקין.
אם אתה רוצה שלא רק יתנו לך בכפית אלא גם יאכילו אותך, ואתה לא רוצה להעלות את הקובץ שלך לכאן. אתה יכול לייצא רק את המודול VBA לקובץ ואתו להעלות.
ככה אולי @מלא ירצה לעזור לך יותר...
תעמוד בחלון הVBA על הטופס שבו נמצא הקוד הנ"ל, תלחץ על מקש ימני, ואז על Export File, ותשמור אותו במחשב.
לאמח"כ תעלה לכאן את הקובץ הזה, ונראה אם יהיה קל יותר לעזור לך. -
מצורף קובץ חדש.
תמחק את המודול הישן, ואז תעלה את החדש לתוכנה (מקש ימני כנ"ל ואז Impot File).
מקווה שיעבוד.
יש לך כמה מקומות שאתה צריך לעדכן בקוד של השליחת מייל, אתה צריך להכניס את הכתובת מייל שלך והסיסמא שלך, וגם את הכתובת מייל של המייל שאליו אתה רוצה שהמייל יישלח (זה יכול להיות אותו מייל שממנו נשלח).השינויים הם בשורות הבאות:
להכניס את הכתובת מייל שלך (במקום YourEmail@gmail.com) :.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "YourEmail@gmail.com"
את הסיסמא (במקום YourPasswoed) :
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "YourPasswoed"
את המייל של הנמען (במקום "To name SendTo@gmail.com" תכתוב פשוט את הכתובת מייל (מוקפת בגרשיים כמובן) :
msgOne.To = "To name <SendTo@gmail.com>"
את המייל שלך שוב (במקום Your Name YourEmail@gmail.com) :
msgOne.From = "Your Name <YourEmail@gmail.com>"
בהצלחה
-
תחליף את הפונקציה האחרונה במודול שלך (Send) לזה:
Public Function Send(strBodyText) as string 'on error goto SendErr Dim cdoConfig Dim msgOne Dim ErrStr Set cdoConfig = CreateObject("CDO.Configuration") With cdoConfig.Fields .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = 465 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "YourEmail@gmail.com" .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "YourPasswoed" .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 .Update End With Set msgOne = CreateObject("CDO.Message") Set msgOne.Configuration = cdoConfig msgOne.To = "To name <SendTo@gmail.com>" msgOne.From = "Your Name <YourEmail@gmail.com>" msgOne.Subject = "בוצע חיפוש" msgOne.TextBody = strBodyText msgOne.Send send = "השליחה בוצעה בהצלחה" exit function SendErr: send = "התרחשה שגיאה במהלך שליחת המייל" End Function