+ Reply to Thread
Results 1 to 7 of 7

get functions in a submit button.

Hybrid View

  1. #1
    Registered User
    Join Date
    12-24-2009
    Location
    Texas
    MS-Off Ver
    2019
    Posts
    16

    get functions in a submit button.

    How do I put these into a submit button on the form. I have created the button I just need to know how to make it do the functions below.

    <<<<<Below this line I would like to go inside my submit button>>>>>
    
    Sub Save_File()
    
    Dim SaveName As String
           SaveName = ActiveSheet.Range("A1").Text
           ActiveWorkbook.SaveAs Filename:="\\servername\share\\forms\" & _
           SaveName & ".xls"
    End Sub
    
    'Will Email Document
    
    Sub SendMail1()
    
       
        'need a reference to MS Outlook object library
       
        Dim olFolder As Outlook.MAPIFolder
        Dim olMailItem As Outlook.MailItem
        Dim olContact As Outlook.Recipient
        Dim r, ToContact
       
        Set olFolder = GetObject("", _
            "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
        For r = 1 To LastRow(ActiveSheet)
            If Trim(ActiveSheet.Cells(r, 1)) <> "" Then
                Set olMailItem = olFolder.Items.Add ' creates a new e-mail message
                With olMailItem
                    .Subject = "KCI SSR has been created file link enclosed" ' message subject
                    Set olContact = .Recipients.Add(ActiveSheet.Cells(2, 1)) ' add To recip
                    If Trim(ActiveSheet.Cells(r, 2)) <> "" Then    'set up cc if email address available
                          Set olContact = .Recipients.Add(ActiveSheet.Cells(r, 2)) ' add cc recipient
                          olContact.Type = olCC ' set latest recipient as CC
                    End If
                    .Body = " SSR has been created to view/edit please click following link " & ActiveSheet.Cells(1, 3) & vbCrLf & vbCrLf & "Regards" & vbCrLf & "IT"
                    .Send ' sends the e-mail message (puts it in the Outbox)
                End With
                Set ToContact = Nothing
                Set olMailItem = Nothing
            End If
           
        Next r
        Set olFolder = Nothing
    End Sub
    
    Function LastRow(ws As Worksheet) As Single
    
        'uses worksheet object
        'returns last used row
     
        On Error Resume Next
       
        With ws
          LastRow = .Cells.Find(What:="*", _
            SearchDirection:=xlPrevious, _
            SearchOrder:=xlByRows).Row
        End With
     
    End Function

  2. #2
    Forum Moderator Leith Ross's Avatar
    Join Date
    01-15-2005
    Location
    San Francisco, Ca
    MS-Off Ver
    2000, 2003, & 2010
    Posts
    23,258

    Re: How do i get these functions in a submit button.

    Hello briant97,

    Assuming all the code you post resides in a VBA module in your project, add the calls to the click event for the submit button. It would help top know what type of button you are using: Forms or Control Toolbox.

    For Example
    Private Sub CommandButton1_Click()
      SaveName
      SendEmail
    End Sub
    Sincerely,
    Leith Ross

    Remember To Do the Following....

    1. Use code tags. Place [CODE] before the first line of code and [/CODE] after the last line of code.
    2. Thank those who have helped you by clicking the Star below the post.
    3. Please mark your post [SOLVED] if it has been answered satisfactorily.


    Old Scottish Proverb...
    Luathaid gu deanamh maille! (Rushing causes delays!)

  3. #3
    Registered User
    Join Date
    12-24-2009
    Location
    Texas
    MS-Off Ver
    2019
    Posts
    16

    Re: get functions in a submit button.

    I went to insert and to form control. When I click submit I get Cannot run the macro "SSR.xls!Submit'. The Macro may not be available in this workbook or all macros my be disabled.

  4. #4
    Registered User
    Join Date
    12-24-2009
    Location
    Texas
    MS-Off Ver
    2019
    Posts
    16

    Re: get functions in a submit button.

    Below is the code that I have.

    Option Explicit
     'Disable Save and SaveAs
    Dim flg As Boolean
    
    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
        If flg Then MsgBox "The 'Save and Save As' function has been disabled." & Chr(10) & "Only 'Submit Button' will work.", vbInformation, "Save and Save As Disabled"
    Cancel = True
    End Sub
    
    Private Sub Workbook_Open()
        flg = True
        Dim x As String
        
        If Me.Name <> "SSR.xls" Then Exit Sub
         
        On Error GoTo ErrorHandler
    One:
        Open "\\server\sharename\Forms\" & ThisWorkbook.Name & _
        " Counter.txt" For Input As #1
        Input #1, x
        Close #1
        x = x + 1
         
    Two:
         '******THIS LINE IS OPTIONAL******
        Sheets(1).Range("A1").Value = x
         '********************************
        Open "\\server\sharename\Forms\" & ThisWorkbook.Name & _
        " Counter.txt" For Output As #1
        Write #1, x
        Close #1
         
        Exit Sub
         
    ErrorHandler:
        Select Case Err.Number
             
        Case 53 'If Counter file does not exist...
    NumberRequired:
            x = InputBox("Enter a Number greater than " & _
            "zero to Begin Counting With", _
            "Create '\\server\sharename\Forms\" & ThisWorkbook.Name & _
            " Counter.txt' File")
            If Not IsNumeric(x) Then GoTo NumberRequired
            If x <= 0 Then GoTo NumberRequired
            Resume Two
        Case Else
            Resume Next
        End Select
        
    End Sub
    
    Private Sub CommandButton1_Click()
    
    
    Sub Save_File()
    
    Dim SaveName As String
           SaveName = ActiveSheet.Range("A1").Text
           ActiveWorkbook.SaveAs Filename:="\\server\sharename\forms\" & _
           SaveName & ".xls"
    End Sub
    
    'Will Email Document
    
    Sub SendMail1()
    
       
        'need a reference to MS Outlook object library
       
        Dim olFolder As Outlook.MAPIFolder
        Dim olMailItem As Outlook.MailItem
        Dim olContact As Outlook.Recipient
        Dim r, ToContact
       
        Set olFolder = GetObject("", _
            "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
        For r = 1 To LastRow(ActiveSheet)
            If Trim(ActiveSheet.Cells(r, 1)) <> "" Then
                Set olMailItem = olFolder.Items.Add ' creates a new e-mail message
                With olMailItem
                    .Subject = "KCI SSR has been created file link enclosed" ' message subject
                    Set olContact = .Recipients.Add(ActiveSheet.Cells(2, 1)) ' add To recip
                    If Trim(ActiveSheet.Cells(r, 2)) <> "" Then    'set up cc if email address available
                          Set olContact = .Recipients.Add(ActiveSheet.Cells(r, 2)) ' add cc recipient
                          olContact.Type = olCC ' set latest recipient as CC
                    End If
                    .Body = " SSR has been created to view/edit please click following link " & ActiveSheet.Cells(1, 3) & vbCrLf & vbCrLf & "Regards" & vbCrLf & "IT"
                    .Send ' sends the e-mail message (puts it in the Outbox)
                End With
                Set ToContact = Nothing
                Set olMailItem = Nothing
            End If
           
        Next r
        Set olFolder = Nothing
    End Sub
    
    Function LastRow(ws As Worksheet) As Single
    
        'uses worksheet object
        'returns last used row
     
        On Error Resume Next
       
        With ws
          LastRow = .Cells.Find(What:="*", _
            SearchDirection:=xlPrevious, _
            SearchOrder:=xlByRows).Row
        End With
     
    End Function
    End Sub

  5. #5
    Forum Expert royUK's Avatar
    Join Date
    11-18-2003
    Location
    Derbyshire,UK
    MS-Off Ver
    Xp; 2007; 2010
    Posts
    26,200

    Re: get functions in a submit button.

    To best describe or illustrate your problem you would be better off attaching a dummy workbook, the workbook should contain the same structure and some dummy data of the same type as the type you have in your real workbook - so, if a cell contains numbers & letters in this format abc-123 then that should be reflected in the dummy workbook.

    If needed supply a before and after sheet in the workbook so the person helping you can see what you are trying to achieve.

    Doing this will ensure you get the result you need!
    Hope that helps.

    RoyUK
    --------
    For Excel Tips & Solutions, free examples and tutorials why not check out my web site

    Free DataBaseForm example

  6. #6
    Registered User
    Join Date
    12-24-2009
    Location
    Texas
    MS-Off Ver
    2019
    Posts
    16

    Re: get functions in a submit button.

    I have attached a dummy workbook.
    Attached Files Attached Files

  7. #7
    Forum Moderator Leith Ross's Avatar
    Join Date
    01-15-2005
    Location
    San Francisco, Ca
    MS-Off Ver
    2000, 2003, & 2010
    Posts
    23,258

    Re: get functions in a submit button.

    Hello briant97,

    Here is the macro for the "Submit" button. Add a VBA module to your workbook project. Copy and paste this code into it. Follow the directions below on how to attach the macro to the button.
    'Submit Button macro
    Sub SaveAndSend()
      Save_File
      SendMail1
    End Sub
    Add the Macro to the Command Button
    1. Right Click the Button.
    2. Click View Code... from the menu.
    3. A new window will open titled Assign Macro.
    4.Click the entry SaveAndSend in the list.
    5. Click OK.
    6. Use CTRL+S to save the changes.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1