Hi Frank
Thanks for your reply ....
I tried this . It'w orking fine ..But still i have one problem. When
schedule it , it showing up for a second ..and it's quiting . Can w
avoid that ..? Also i have a question..if we want to edit that macro
how we can open that ....Since i have set it as "running macros whil
opening workbook .."
Basically i am checking already existing sheet values with databs
output ..and if it different it has to send an email .
I have included the application.displayalerts ......and all in th
mainfunction ...
sub auto _open ..
CAn u please tell me ..?
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim data As Worksheet
Sub Auto_open()
Application.displayalerts =false
Set data = Application.Worksheets("DATA")
Call setupConnections
Call populatedata
Worksheets("DATA").Activate
If cn.State = 1 Then cn.Close
Activeworkbook.save
Application.quit
End Sub
Function populatedata()
Dim mymail As New CDONTS.NewMail
Worksheets("DATA").Activate
ActiveSheet.Range("A2:Z1000").Activate
Dim ws As Worksheet
Selection.ClearContents
Dim sql As String
sql = "select distinct mkt_nam from hist_frmly_lives"
Set rs = CreateObject("ADODB.Recordset")
If rs.State = 1 Then rs.Close
rs.Open sql, cn
' On Error Resume Next
' ActiveSheet.Range("DATA").Select
Do While Not rs.EOF
Count = 0
For Each CellVal In rs.Fields
Err.Clear
ActiveCell.Value = rs(Count)
If Err.Number < 0 Then ActiveCell.Value
rs.Fields(Count)
ActiveCell.Offset(0, 1).Select
Count = Count + 1
Next
ActiveCell.Offset(1, -Count).Select
rs.movenext
Loop
lr1 = Worksheets("ACTUAL").UsedRange.Rows.Count
lr2 = Worksheets("DATA").UsedRange.Rows.Count
If lr1 < lr2 Then
mymail.From = "
mymail.To = "
mymail.Subject = "Test"
mymail.Body = "sheets are different"
mymail.Send
Set mymail = Nothing
Else
For r = 2 To lr1
cf1 = ""
cf2 = ""
On Error Resume Next
cf1 = Worksheets("DATA").Cells(r, 1).FormulaLocal
cf2 = Worksheets("ACTUAL").Cells(r, 1).FormulaLocal
On Error GoTo 0
If cf1 < cf2 Then
mymail.From = "
mymail.To = "
mymail.Subject = "Test"
mymail.Body = "sheets are different"
mymail.Send
Set mymail = Nothing
Exit For
End If
Next r
End If
On Error GoTo 0
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Function
Function setupConnections()
cn.Open "ppgp.ppg.pfizer.comdsn", "ops$pyrcmdw", "pyrcmdw03"
cn.CursorLocation = adUseClient
End Functio
--
ps
-----------------------------------------------------------------------
psk's Profile:
http://www.excelforum.com/member.php...fo&userid=1573
View this thread:
http://www.excelforum.com/showthread.php?threadid=27334