help with salaries Database

mobarak ahmed

mobarak ahmed

Member
Local time
Today, 21:37
Joined
May 28, 2021
Messages
96
hi dears , i hope you are doing well
i have two issues here
1- in "Salaries_Emp" and "Salaries_Temp" Form when i Payroll Period then select Dep_Code then ID and save the record by clicking button Save
the Dep_Code combobox does not return to the last selection department so i have to select department every time i make employee record
2- i want to make a form to send emails to outlook with attached pdf from Salaries_Slip with criteria "email_address" as every record contain the same email address
goes together to that email
any help will be appreciated
 

Attachments

mobarak ahmed said:
Dep_Code combobox does not return to the last selection department so i have to select department every time i make employee record
Click to expand...
Try in "Salaries_Emp" form:
Code: 
Private Sub Save_Click()
Dim sPeriod As String
Dim lDep As Long ' for restore old value

    If Me.cboPayPeriod.ListIndex = -1 Then
        MsgBox "Please select a Period for this payroll"
        Me.cboPayPeriod.SetFocus
        Exit Sub
    End If
    If Me.Combo_Dep.ListIndex > -1 Then
        If MsgBox("Do you want to save current Employee Monthly Attendance ?", _
                                vbYesNo + vbQuestion, "Save New Monthly Attendance") = vbNo Then
            DoCmd.CancelEvent
            Me.Undo
            Me.Combo_Dep.SetFocus
        Else
            Me.Dirty = False
            sPeriod = Me.cboPayPeriod
            lDep = Me.Combo_Dep

            DoCmd.GoToRecord acForm, Me.Name, acNewRec
          
            Me.cboPayPeriod = sPeriod
            Me.Combo_Dep = lDep
        End If
    Else
        Me.Combo_Dep.SetFocus
        Exit Sub
    End If
    
    Me.Combo_Dep.Requery
    
End Sub

... and "Salaries_Temp" Form :
Code: 
Private Sub Save_Click()
Dim sPeriod As String
Dim lDep As Long ' for restore old value

If Me.cboPayPeriod.ListIndex < 0 Then
    MsgBox "Please select a Period for this payroll"
    Me.cboPayPeriod.SetFocus
    Exit Sub
End If
If IsNull(Me.Combo_Dep) = False Then
    If MsgBox("Do you want to save current Employee Monthly Attendance ?", vbYesNo + vbQuestion, "Save New Monthly Attendance") = vbNo Then
        DoCmd.CancelEvent
        Me.Undo
        Me.Combo_Dep.SetFocus
    Else
      
        Me.Dirty = False
        sPeriod = Me.cboPayPeriod
        lDep = Me.Combo_Dep
        
        DoCmd.GoToRecord acForm, Me.Name, acNewRec
        
        Me.cboPayPeriod = sPeriod
        Me.Combo_Dep = lDep

        'Me.cboPayPeriod.DefaultValue = "'" & sPeriod & "'"
        'DoCmd.GoToRecord , , acNext
    End If
Else
    Me.Combo_Dep.SetFocus
    Exit Sub
End If
Me.Combo_Dep.Requery
End Sub
 
Eugene-LS said:
Try in "Salaries_Emp" form:
Code: 
Private Sub Save_Click()
Dim sPeriod As String
Dim lDep As Long ' for restore old value

    If Me.cboPayPeriod.ListIndex = -1 Then
        MsgBox "Please select a Period for this payroll"
        Me.cboPayPeriod.SetFocus
        Exit Sub
    End If
    If Me.Combo_Dep.ListIndex > -1 Then
        If MsgBox("Do you want to save current Employee Monthly Attendance ?", _
                                vbYesNo + vbQuestion, "Save New Monthly Attendance") = vbNo Then
            DoCmd.CancelEvent
            Me.Undo
            Me.Combo_Dep.SetFocus
        Else
            Me.Dirty = False
            sPeriod = Me.cboPayPeriod
            lDep = Me.Combo_Dep

            DoCmd.GoToRecord acForm, Me.Name, acNewRec
         
            Me.cboPayPeriod = sPeriod
            Me.Combo_Dep = lDep
        End If
    Else
        Me.Combo_Dep.SetFocus
        Exit Sub
    End If
   
    Me.Combo_Dep.Requery
   
End Sub

... and "Salaries_Temp" Form :
Code: 
Private Sub Save_Click()
Dim sPeriod As String
Dim lDep As Long ' for restore old value

If Me.cboPayPeriod.ListIndex < 0 Then
    MsgBox "Please select a Period for this payroll"
    Me.cboPayPeriod.SetFocus
    Exit Sub
End If
If IsNull(Me.Combo_Dep) = False Then
    If MsgBox("Do you want to save current Employee Monthly Attendance ?", vbYesNo + vbQuestion, "Save New Monthly Attendance") = vbNo Then
        DoCmd.CancelEvent
        Me.Undo
        Me.Combo_Dep.SetFocus
    Else
     
        Me.Dirty = False
        sPeriod = Me.cboPayPeriod
        lDep = Me.Combo_Dep
       
        DoCmd.GoToRecord acForm, Me.Name, acNewRec
       
        Me.cboPayPeriod = sPeriod
        Me.Combo_Dep = lDep

        'Me.cboPayPeriod.DefaultValue = "'" & sPeriod & "'"
        'DoCmd.GoToRecord , , acNext
    End If
Else
    Me.Combo_Dep.SetFocus
    Exit Sub
End If
Me.Combo_Dep.Requery
End Sub
Click to expand...
it is works and thanks for help, but the recorded ID list still appeared
before doing this . if you recorded an employee it's disappeared from iD list now after record it it's still here
 
mobarak ahmed said:
if you recorded an employee it's disappeared from iD list now after record it it's still here
Click to expand...
Oh that's easy, put the command:
Code: 
Me.Combo_Emp_Name.Requery
After string:
Code: 
lDep = Me.Combo_Dep

It should look like this:
Code: 
        ' ...
        Else
            Me.Dirty = False
            sPeriod = Me.cboPayPeriod
            lDep = Me.Combo_Dep
            Me.Combo_Emp_Name.Requery
            DoCmd.GoToRecord acForm, Me.Name, acNewRec
        
            Me.cboPayPeriod = sPeriod
            Me.Combo_Dep = lDep
        End If
        ' ...
 
mobarak ahmed said:
2- i want to make a form to send emails to outlook with attached pdf from Salaries_Slip with criteria "email_address" as every record contain the same email address
goes together to that email
Click to expand...
Code: 
Public Sub SendEmailWtAttachment(sToEMails$, sSybject$, Optional sBody$, _
        Optional sAttachmentPath$, Optional sSaveCopyToFolder$)
'es 16.02.2005 - LE 26.12.2022 v005
'---------------------------------------------------------------------------------------------------
'процедура отправки сообщения посредством MS OutLook с вложением (опционально) и сохранением файла копии (опционально)
'procedure for sending a message via MS OutLook With attachment (optional) and saving copy file (optional)
'---------------------------------------------------------------------------------------------------
'Аргументы:
'   sToEMails          'Адрес, или адреса через точку с запятой - Address, or semicolon addresses
'   sSybject           'Тема - Subject
'   sBody              'Текст (тело сообщения) - Text (message body)
'   sAttachmentPath    'Полный путь к вложению (опционально) - Full path to attachment (optional)
'   sSaveCopyToFolder  'Путь к к папке куда сохранить копию (опционально)
                       'Path to the folder where to save the copy (optional)
'---------------------------------------------------------------------------------------------------
'Usage:
'   SendEmailWtAttachment "name@domen.ru", "Text of Subject", "message ...", "C:\Temp\filename.zip"
'---------------------------------------------------------------------------------------------------

Dim olObjApp As Object      'MS Outlook application
Dim olObjItem As Object     'MS Outlook item (message)
Dim s$

On Error GoTo SendEmailWtAttachmentErr

    Set olObjApp = CreateObject("Outlook.Application")
    Set olObjItem = olObjApp.CreateItem(0)
    '* cм https://msdn.microsoft.com/ru-ru/library/office/ff869291.aspx
   
'Creating message
    With olObjItem
        .To = sToEMails
        .Subject = sSybject
        .Body = sBody

        If sAttachmentPath <> "" Then
            If Dir(sAttachmentPath) <> "" Then
                .Attachments.Add sAttachmentPath
            End If
        End If
       
        'Saving a message (still in "Drafts")
        .Save    'Сохранение сообщения (пока в Черновиках)
       
        'Отправка - Но это не фактическая отправка, а только помещение в папку "Исходящие" (OutBox)
        'Sending - But this is not the actual sending, but only putting it in the Outbox folder (OutBox)
        .Send
        '... а далеше OutLook будет действовать по своим настройкам ("Мгновенная отправка")
        ''...and then OutLook will act on its settings ('Instant Send')

'Экспортирование - если указан аргумент - Export - if the argument is specified
        If sSaveCopyToFolder <> "" Then
            s = sSaveCopyToFolder
            If Right(s, 1) <> "\" Then s = s & "\"

            s = s & sSybject & ".msg" 'Путь сохранения копии - Save copy path
            Debug.Print s
            .SaveAs s, 3
        End If
   

    End With
   
    Set olObjItem = Nothing
    Set olObjApp = Nothing
    Exit Sub
   
SendEmailWtAttachmentErr:
   If Err.Number = "287" Then
      MsgBox "You declined to create a message!", vbInformation, "Сообщение не создано"
   Else
      MsgBox Err.Description, vbCritical, "Error!"
   End If
End Sub
 
Last edited:
Eugene-LS said:
Oh that's easy, put the command:
Code: 
Me.Combo_Emp_Name.Requery
After string:
Code: 
lDep = Me.Combo_Dep

It should look like this:
Code: 
        ' ...
        Else
            Me.Dirty = False
            sPeriod = Me.cboPayPeriod
            lDep = Me.Combo_Dep
            Me.Combo_Emp_Name.Requery
            DoCmd.GoToRecord acForm, Me.Name, acNewRec
       
            Me.cboPayPeriod = sPeriod
            Me.Combo_Dep = lDep
        End If
        ' ...
Click to expand...
Thanks its works now
 
Eugene-LS said:
Code: 
Public Sub SendEmailWtAttachment(sToEMails$, sSybject$, Optional sBody$, _
        Optional sAttachmentPath$, Optional sSaveCopyToFolder$)
'es 16.02.2005 - LE 26.12.2022 v005
'---------------------------------------------------------------------------------------------------
'процедура отправки сообщения посредством MS OutLook с вложением (опционально) и сохранением файла копии (опционально)
'procedure for sending a message via MS OutLook With attachment (optional) and saving copy file (optional)
'---------------------------------------------------------------------------------------------------
'Аргументы:
'   sToEMails          'Адрес, или адреса через точку с запятой - Address, or semicolon addresses
'   sSybject           'Тема - Subject
'   sBody              'Текст (тело сообщения) - Text (message body)
'   sAttachmentPath    'Полный путь к вложению (опционально) - Full path to attachment (optional)
'   sSaveCopyToFolder  'Путь к к папке куда сохранить копию (опционально)
                       'Path to the folder where to save the copy (optional)
'---------------------------------------------------------------------------------------------------
'Usage:
'   SendEmailWtAttachment "name@domen.ru", "Text of Subject", "message ...", "C:\Temp\filename.zip"
'---------------------------------------------------------------------------------------------------

Dim olObjApp As Object      'MS Outlook application
Dim olObjItem As Object     'MS Outlook item (message)
Dim s$

On Error GoTo SendEmailWtAttachmentErr

    Set olObjApp = CreateObject("Outlook.Application")
    Set olObjItem = olObjApp.CreateItem(0)
    '* cм https://msdn.microsoft.com/ru-ru/library/office/ff869291.aspx
   
'Creating message
    With olObjItem
        .To = sToEMails
        .Subject = sSybject
        .Body = sBody

        If sAttachmentPath <> "" Then
            If Dir(sAttachmentPath) <> "" Then
                .Attachments.Add sAttachmentPath
            End If
        End If
       
        'Saving a message (still in "Drafts")
        .Save    'Сохранение сообщения (пока в Черновиках)
       
        'Отправка - Но это не фактическая отправка, а только помещение в папку "Исходящие" (OutBox)
        'Sending - But this is not the actual sending, but only putting it in the Outbox folder (OutBox)
        .Send
        '... а далеше OutLook будет действовать по своим настройкам ("Мгновенная отправка")
        ''...and then OutLook will act on its settings ('Instant Send')

'Экспортирование - если указан аргумент - Export - if the argument is specified
        If sSaveCopyToFolder <> "" Then
            s = sSaveCopyToFolder
            If Right(s, 1) <> "\" Then s = s & "\"

            s = s & sSybject & ".msg" 'Путь сохранения копии - Save copy path
            Debug.Print s
            .SaveAs s, 3
        End If
   

    End With
   
    Set olObjItem = Nothing
    Set olObjApp = Nothing
    Exit Sub
   
SendEmailWtAttachmentErr:
   If Err.Number = "287" Then
      MsgBox "You declined to create a message!", vbInformation, "Сообщение не создано"
   Else
      MsgBox Err.Description, vbCritical, "Error!"
   End If
End Sub
Click to expand...
I don’t have the ability or knowledge to apply this code to my database unfortunately but thanks for help I appreciate that
 
You must log in or register to reply here.

Similar threads

D
Solved Creating a query with 1 table and 4 queries adds a new record
Replies
10
Views
243
Pat Hartman
P
H
Beginner Seeking Help: Building an Access Database for Volunteer Fire Department
Replies
9
Views
489
arnelgp
arnelgp
T
Active X Error when emailing from Access
Replies
19
Views
804
The_Doc_Man
The_Doc_Man
L
Send looping Email
Replies
3
Views
787
looma123
L
S
Problem to run Access database
Replies
3
Views
263
mike60smart
mike60smart

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom