Advertisement
Combreal

excelScript.vba

Nov 30th, 2020 (edited)
1,278
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Sub Formula_Example()
  2.     Range("b4").Formula = "=b2+b3"
  3.  
  4. End Sub
  5.  
  6. Sub Effacer_B4()
  7.     If MsgBox("Etes-vous certain de vouloir supprimer le contenu de B4 ?", vbYesNo, "Demande de confirmation") = vbYes Then
  8.         Range("B4").ClearContents
  9.         MsgBox "Le contenu de B4 a été effacé !"
  10.     End If
  11. End Sub
  12.  
  13. Sub GetCell()
  14.     Dim userName As String
  15.    
  16.     'userName = InputBox("Enter username")
  17.    userName = Range("a15").Value
  18.     MsgBox "user : " & userName
  19. End Sub
  20.  
  21. Sub GetUser()
  22.     Dim userName As String
  23.     Dim objConnection, objCommand, objRecordSet
  24.     Dim strFName, strLName
  25.    
  26.     userName = Range("a15").Value
  27.     Set RootDSE = GetObject("LDAP://RootDSE")
  28.     searchRoot = RootDSE.Get("defaultNamingContext")
  29.     Set objConnection = CreateObject("ADODB.Connection")
  30.     Set objCommand = CreateObject("ADODB.Command")
  31.     Set objRecordSet = CreateObject("ADODB.Recordset")
  32.     objConnection.Provider = "ADsDSOObject"
  33.     objConnection.Open "Active Directory Provider"
  34.     Set objCommand.ActiveConnection = objConnection
  35.     strQueryText = "<LDAP://" & searchRoot & ">;(&(objectCategory=Person)(samAccountName=" & userName & "));" & "givenName,sn,displayName"
  36.     objCommand.CommandText = strQueryText
  37.     objCommand.Properties("Page Size") = 15
  38.     objCommand.Properties("Timeout") = 25
  39.     objCommand.Properties("Cache Results") = False
  40.     Set objRecordSet = objCommand.Execute
  41.     objRecordSet.MoveFirst
  42.    
  43.     strFName = objRecordSet.Fields("givenName").Value
  44.     strLName = objRecordSet.Fields("sn").Value
  45.     MsgBox strFName & " " & strLName
  46. End Sub
  47.  
  48. Sub SendMail()
  49.     With CreateObject("CDO.Message")
  50.         .From = "tony.montana@dbs.fr"
  51.         .To = "bt.conio@dbs.fr"
  52.         .Subject = "test"
  53.         .TextBody = "test"
  54.         .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
  55.         .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.dbs.fr"
  56.         .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
  57.         .Configuration.Fields.Update
  58.         On Error Resume Next
  59.         .Send
  60.     End With
  61. End Sub
  62.  
  63.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement