Pages

Thursday, October 27, 2011

Send email from classic asp using CDO

<% 
 Dim myMail,HTML,msg
 dim dbn
 dbn="../yourdbpath/Database.mdb"

 ID = Request("ID")
 fromAddress = Request.Form("fromAddress")
 Set cn = Server.CreateObject("ADODB.Connection")

 cn.provider="microsoft.jet.oledb.4.0"
 cn.connectionstring=server.mappath(dbn)
 cn.open
 'cn.Open cstring

 q = "SELECT * FROM users WHERE userid LIKE '" & fromAddress & "'"
 Set rs = cn.Execute(q)

 if rs.EOF then
  Response.write "<font color=""brown"" >Sorry! You have entered wrong Email Address or Email address not in the list.  </font>"
 else
  password=rs("password")

  msg = "User password helper! " & chr(10) & chr(10)
  msg = msg & "Please Use below password to login to user area " & Title & chr(10)
  msg = msg & "EmailAddress: " & fromAddress & chr(10)
  msg = msg & "Password: " & password & chr(10)

  Set myMail = Server.CreateObject("CDO.Message") 
  Dim cdoConfig 
  Set cdoConfig = myMail.Configuration 
  With cdoConfig.Fields 
  .Item("
http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
  .Item("
http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.server.com" 
  .Item("
http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
  '*** Authentication ***' 
  .Item ("
http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 
  .Item ("
http://schemas.microsoft.com/cdo/configuration/sendusername") = "username" '*** User ***' 
  .Item ("
http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password" '*** Password ***' 
  .Item ("
http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30 
  .Update 
  End With 

  myMail.Configuration = cdoConfig
  myMail.From = "from@site.com"
  myMail.To   = fromAddress
  myMail.Subject =   "User password !"
  myMail.HTMLBody = msg 

  myMail.Send 
  Set myMail = Nothing 
  Response.write "<font color=""brown"" >Your pasword has been sent to your Email Address.. Pls check after some time. In case any problem Please contact the administrator </font>"
 end if
%> 

Wednesday, October 19, 2011

Add or Remove apostrophe to cell in active excel sheet

Option Explicit
Sub DeathToApostrophe()
    Dim s As Range, temp As String
    If MsgBox("Are you sure you want to remove all leading apostrophes from the entire sheet?", _
    vbOKCancel + vbQuestion, "Remove Apostrophes") = vbCancel Then Exit Sub
    Application.ScreenUpdating = False
    For Each s In ActiveSheet.UsedRange
        If s.HasFormula = False Then
             'Gets text and rewrites to same cell without   the apostrophe.
            s.Value = s.Text
        End If
    Next s
    Application.ScreenUpdating = True
End Sub


Sub AddApostrophes()
    Dim cel As Range
    Dim strw As String
    
    strw = "You cannot undo this task."
    strw = strw & " You may want to save your work to a new file."
    strw = strw & " Press OK to proceed, Cancel to quit."
    If vbCancel = MsgBox(strw, vbOKCancel + vbCritical, "Task Cannot Be Undone") Then Exit Sub
    
    For Each cel In ActiveSheet.UsedRange
        cel.Value = "'" & cel.Value
    Next cel
End Sub


How to use
  1. Copy above code.
  2. In Excel press Alt + F11 to enter the VBE.
  3. Right-click desired file on left.
  4. Choose Insert -Module.
  5. Paste code into the right pane.
  6. Press Alt + Q to close the VBE.
  7. Save workbook before any other changes. 
Test the code
  1. Ensure Active sheet is the desired sheet.
  2. Press Alt + F8.
  3. Choose 'DeathToApostrophe'.
  4. Press 'Run'.
  5. Confirm with 'Ok' to run.