Sorry it took so long to respond, it's been very busy around here lately. Any help is greatly apprieciated. Thanks in advance!
Here is my code:
Workbooks.Open Filename:= _
"C:\Documents and Settings\ABC\Desktop\ABC_Hourly.xls"
Sheets("Sheet3").Select
Cells.Select
Selection.ClearContents
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Documents and Settings\ABC\Desktop\Source Code Report.txt", _
Destination:=Range("A1"))
.Name = "Source Code Report"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("C4:J20").Select
Selection.Copy
Sheets("Sheet1").Select
Range("D2").Select
ActiveSheet.Paste
Sheets("Sheet2").Select
Application.CutCopyMode = False
Sheets("Sheet2").Select
Cells.Select
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set rng = Nothing
On Error Resume Next
Set rng = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "abc@acb.com"
.CC = ""
.BCC = ""
.Subject = "Hourly Report"
.HTMLBody = RangetoHTML(rng)
.Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
ActiveWorkbook.Save
ActiveWindow.Close
End Sub
|