Hi All,
I'm getting this error (compiler err: user-defined type not defined) when im trying out macro through MS outlook 2007 version.
I even enabled required MS object libraries as well.
Pls help me.
CODE: for searching mails for specific numbers.
'
' SpreadsheetItemsExport
' OPTIMA L3 SUPPORT
' ISSUE TRACKER
'
Sub ExportToExcel()
On Error GoTo ErrHandler
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rng As Excel.Range
Dim rng1 As Excel.Range
Dim strSheet As String
Dim strPath As String
Dim StartDate As String
Dim intRowCounter As Integer
Dim intColumnCounter As Integer
Dim msg As Outlook.MailItem
Dim nms As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
Dim itm As Object
Dim dupchk As Integer
Dim skip_flag As Integer
Dim sname As String
Dim subjL As Integer
Dim ran As Integer
Dim str1 As String
Dim str2 As String
Dim result As String
Dim allMatches As Object
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
Dim Ret
Dim msgret
StartDate = InputBox("Enter the Start Date in yy/mm/dd Format", "Date Prompt (yy/mm/dd)")
' Define Excel Workbook and Path
str1 = "IssueTracker"
str2 = ".xlsx"
strSheet = str1 & Format(StartDate, "mmmyyyy") & str2
strPath = "\\rutvnasfin0005\data_grp9_fin\EPM\STAR L3 support offshore\Issue Tracker\"
strSheet = strPath & strSheet
'Debug.Print strSheet
'FUNCTION TO CHECK WHETHER EXCEL IS ALREADY IN USE OR NOT
Ret = IsWorkBookOpen(strSheet)
If Ret = True Then
msgret = MsgBox("Do you want to Continue [Read Only]?", vbYesNo, "File is Already in use")
If msgret = vbNo Then
Exit Sub
End If
End If
'SELECT OUTLOOK FOLDER TO EXPORT
Set nms = Application.GetNamespace("MAPI")
Set fld = nms.PickFolder
'Error Handler for potential errors with Select Folder dialog box - " Set fld = nms.PickFolder "
If fld Is Nothing Then
MsgBox "There are no mail messages to export", vbOKOnly, "Error"
Exit Sub
ElseIf fld.DefaultItemType <> olMailItem Then
MsgBox "There are no mail messages to export", vbOKOnly, "Error"
Exit Sub
ElseIf fld.Items.Count = 0 Then
MsgBox "There are no mail messages to export", vbOKOnly, "Error"
Exit Sub
End If
'HEADER
Set appExcel = CreateObject("Excel.Application")
appExcel.Visible = True
Set wkb = appExcel.Workbooks.Open(strSheet)
Set wks = wkb.ActiveSheet
appExcel.ActiveSheet.Name = Format(StartDate, "mmm-yyyy")
Set rng = wks.Cells(1, 1)
rng.Value = "DATE"
rng.Font.Name = "Cambria"
rng.Font.Size = 12
rng.Font.Bold = True
rng.Interior.ThemeColor = xlThemeColorLight2
rng.Interior.TintAndShade = 0.599993896298105
Set rng = wks.Cells(1, 2)
rng.Value = "ISSUE TAG"
rng.Font.Name = "Cambria"
rng.Font.Size = 12
rng.Font.Bold = True
rng.Interior.ThemeColor = xlThemeColorLight2
rng.Interior.TintAndShade = 0.599993896298105
Set rng = wks.Cells(1, 3)
rng.Value = "INCIDENT"
rng.Font.Name = "Cambria"
rng.Font.Size = 12
rng.Font.Bold = True
rng.Interior.ThemeColor = xlThemeColorLight2
rng.Interior.TintAndShade = 0.599993896298105
Set rng = wks.Cells(1, 4)
rng.Value = "ENV"
rng.Font.Name = "Cambria"
rng.Font.Size = 12
rng.Font.Bold = True
rng.Interior.ThemeColor = xlThemeColorLight2
rng.Interior.TintAndShade = 0.599993896298105
Set rng = wks.Cells(1, 5)
rng.Value = "MODULE"
rng.Font.Name = "Cambria"
rng.Font.Size = 12
rng.Font.Bold = True
rng.Interior.ThemeColor = xlThemeColorLight2
rng.Interior.TintAndShade = 0.599993896298105
Set rng = wks.Cells(1, 6)
rng.Value = "CATEGORY"
rng.Font.Name = "Cambria"
rng.Font.Size = 12
rng.Font.Bold = True
rng.Interior.ThemeColor = xlThemeColorLight2
rng.Interior.TintAndShade = 0.599993896298105
Set rng = wks.Cells(1, 7)
rng.Value = "OWNER"
rng.Font.Name = "Cambria"
rng.Font.Size = 12
rng.Font.Bold = True
rng.Interior.ThemeColor = xlThemeColorLight2
rng.Interior.TintAndShade = 0.599993896298105
Set rng = wks.Cells(1, 8)
rng.Value = "REMARK"
rng.Font.Name = "Cambria"
rng.Font.Size = 12
rng.Font.Bold = True
rng.Interior.ThemeColor = xlThemeColorLight2
rng.Interior.TintAndShade = 0.599993896298105
appExcel.Range("A1").Select
appExcel.Range("A1:D1").Borders.LineStyle = xlContinuous
appExcel.Range("A:A").ColumnWidth = 11
appExcel.Range("B:B").ColumnWidth = 60
appExcel.Range("C:C").ColumnWidth = 14
appExcel.Range("D:D").ColumnWidth = 10
appExcel.Range("E:E").ColumnWidth = 9
appExcel.Range("F:F").ColumnWidth = 13
appExcel.Range("G:G").ColumnWidth = 11
appExcel.Range("G:G").ColumnWidth = 10
appExcel.ActiveWindow.SplitColumn = 0
appExcel.ActiveWindow.SplitRow = 1
appExcel.ActiveWindow.FreezePanes = True
With appExcel.Columns("D:D").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="PROD,NON-PROD"
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
With appExcel.Columns("F:F").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="Data-Analysis,Processing,Data-Req,Tactical"
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
If appExcel.Application.WorksheetFunction.CountA(wks.Cells) <> 0 Then
intRowCounter = wks.Cells.Find(What:="*", _
After:=wks.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
intRowCounter = 1
End If
'OUTLOOK EXPORT
For Each itm In fld.Items
intColumnCounter = 2
If TypeOf itm Is MailItem Then
Set msg = itm
If (Format(msg.SentOn, "yy/mm/dd") < StartDate) Then
Exit For
End If
If (((msg.SenderName = "Anusha, Maddineni [CCC-OT_IT NE]") Or _
(msg.SenderName = "Singh, Vinay Kumar1 [CCC-OT_IT NE]") Or _
(msg.SenderName = "Pillai, Sajith [CCC-OT_IT NE]") Or _
(msg.SenderName = "Battini, Bhanu Chandrika [CCC-OT_IT NE]") Or _
(msg.SenderName = "Babu, Tarun [CCC-OT_IT NE]") Or _
(msg.SenderName = "Gonuguntla, Ganesh [CCC-OT_IT NE]") Or _
(msg.SenderName = "Manoharan, Pugazhendhi [CCC-OT_IT NE]") Or _
(msg.SenderName = "Tammaneni, Vishnu Vardana [CCC-OT_IT NE]") Or _
(msg.SenderName = "Karri, Prasada [CCC-OT_IT NE]") Or _
(msg.SenderName = "Ramadass, Praveenkumar [CCC-OT_IT NE]")) And _
(Format(msg.SentOn, "yy/mm/dd") >= StartDate) And _
(Left(msg.Subject, 13) <> "Status Report") And _
(Left(msg.Subject, 19) <> "Missed conversation") And _
(Left(msg.Subject, 9) <> "Task list") And _
(Left(msg.Subject, 8) <> "Tasklist")) Then
intRowCounter = intRowCounter + 1
'SUBJECT COLUMN (ISSUE)
Set rng = wks.Cells(intRowCounter, intColumnCounter)
subjectcont = msg.Subject
subjL = Len(msg.Subject) - 3
subj = Left(subjectcont, 3)
'RE & FW REMOVAL
If ((UCase(subj) = "RE:") Or (UCase(subj) = "FW:")) Then
subjectcont = Mid(msg.Subject, 5, subjL)
Else
subjectcont = msg.Subject
End If
skip_flag = 0
'DUPLICATE CHECK FOR SUBJECT
For dupchk = 1 To intRowCounter
Set rng1 = wks.Cells(dupchk, intColumnCounter)
If (rng1.Value = subjectcont) Then
skip_flag = 1
intRowCounter = intRowCounter - 1
Exit For
Else
skip_flag = 0
End If
Next
If (skip_flag = 0) Then
rng.Value = subjectcont
'DATE COLUMN
intColumnCounter = intColumnCounter - 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = Format(msg.SentOn, "dd-mmm-yyyy")
intColumnCounter = intColumnCounter + 2
Set rng = wks.Cells(intRowCounter, intColumnCounter)
RE.Pattern = "(INC\d{10})"
RE.Global = True
Set allMatches = RE.Execute(msg.Body)
If allMatches.Count <> 0 Then
result = allMatches.Item(0).submatches.Item(0)
Else
result = " "
End If
rng.Value = result
'SENDER COLUMN(OWNER)
intColumnCounter = intColumnCounter + 4
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.SenderName
'BLANK REMARK
intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = " "
End If
End If
End If
Next itm
appExcel.UserControl = True
wkb.Close savechanges:=True
Set rng = Nothing
Set rng1 = Nothing
Set wks = Nothing
Set wkb = Nothing
appExcel.Quit
MsgBox ("Completed !!!")
Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set rng = Nothing
Set rng1 = Nothing
Set msg = Nothing
Set nms = Nothing
Set fld = Nothing
Set itm = Nothing
Set allMatches = Nothing
Set RE = Nothing
Exit Sub
ErrHandler: If Err.Number = 1004 Then
MsgBox strSheet & " doesn't exist", vbOKOnly, "Error"
Else
MsgBox Err.Number & "; Description: ", vbOKOnly, "Error"
End If
Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set rng = Nothing
Set rng1 = Nothing
Set msg = Nothing
Set nms = Nothing
Set fld = Nothing
Set itm = Nothing
Set allMatches = Nothing
Set RE = Nothing
End Sub
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
Regards,
Ganesh G.
I'm getting this error (compiler err: user-defined type not defined) when im trying out macro through MS outlook 2007 version.
I even enabled required MS object libraries as well.
Pls help me.
CODE: for searching mails for specific numbers.
'
' SpreadsheetItemsExport
' OPTIMA L3 SUPPORT
' ISSUE TRACKER
'
Sub ExportToExcel()
On Error GoTo ErrHandler
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rng As Excel.Range
Dim rng1 As Excel.Range
Dim strSheet As String
Dim strPath As String
Dim StartDate As String
Dim intRowCounter As Integer
Dim intColumnCounter As Integer
Dim msg As Outlook.MailItem
Dim nms As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
Dim itm As Object
Dim dupchk As Integer
Dim skip_flag As Integer
Dim sname As String
Dim subjL As Integer
Dim ran As Integer
Dim str1 As String
Dim str2 As String
Dim result As String
Dim allMatches As Object
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
Dim Ret
Dim msgret
StartDate = InputBox("Enter the Start Date in yy/mm/dd Format", "Date Prompt (yy/mm/dd)")
' Define Excel Workbook and Path
str1 = "IssueTracker"
str2 = ".xlsx"
strSheet = str1 & Format(StartDate, "mmmyyyy") & str2
strPath = "\\rutvnasfin0005\data_grp9_fin\EPM\STAR L3 support offshore\Issue Tracker\"
strSheet = strPath & strSheet
'Debug.Print strSheet
'FUNCTION TO CHECK WHETHER EXCEL IS ALREADY IN USE OR NOT
Ret = IsWorkBookOpen(strSheet)
If Ret = True Then
msgret = MsgBox("Do you want to Continue [Read Only]?", vbYesNo, "File is Already in use")
If msgret = vbNo Then
Exit Sub
End If
End If
'SELECT OUTLOOK FOLDER TO EXPORT
Set nms = Application.GetNamespace("MAPI")
Set fld = nms.PickFolder
'Error Handler for potential errors with Select Folder dialog box - " Set fld = nms.PickFolder "
If fld Is Nothing Then
MsgBox "There are no mail messages to export", vbOKOnly, "Error"
Exit Sub
ElseIf fld.DefaultItemType <> olMailItem Then
MsgBox "There are no mail messages to export", vbOKOnly, "Error"
Exit Sub
ElseIf fld.Items.Count = 0 Then
MsgBox "There are no mail messages to export", vbOKOnly, "Error"
Exit Sub
End If
'HEADER
Set appExcel = CreateObject("Excel.Application")
appExcel.Visible = True
Set wkb = appExcel.Workbooks.Open(strSheet)
Set wks = wkb.ActiveSheet
appExcel.ActiveSheet.Name = Format(StartDate, "mmm-yyyy")
Set rng = wks.Cells(1, 1)
rng.Value = "DATE"
rng.Font.Name = "Cambria"
rng.Font.Size = 12
rng.Font.Bold = True
rng.Interior.ThemeColor = xlThemeColorLight2
rng.Interior.TintAndShade = 0.599993896298105
Set rng = wks.Cells(1, 2)
rng.Value = "ISSUE TAG"
rng.Font.Name = "Cambria"
rng.Font.Size = 12
rng.Font.Bold = True
rng.Interior.ThemeColor = xlThemeColorLight2
rng.Interior.TintAndShade = 0.599993896298105
Set rng = wks.Cells(1, 3)
rng.Value = "INCIDENT"
rng.Font.Name = "Cambria"
rng.Font.Size = 12
rng.Font.Bold = True
rng.Interior.ThemeColor = xlThemeColorLight2
rng.Interior.TintAndShade = 0.599993896298105
Set rng = wks.Cells(1, 4)
rng.Value = "ENV"
rng.Font.Name = "Cambria"
rng.Font.Size = 12
rng.Font.Bold = True
rng.Interior.ThemeColor = xlThemeColorLight2
rng.Interior.TintAndShade = 0.599993896298105
Set rng = wks.Cells(1, 5)
rng.Value = "MODULE"
rng.Font.Name = "Cambria"
rng.Font.Size = 12
rng.Font.Bold = True
rng.Interior.ThemeColor = xlThemeColorLight2
rng.Interior.TintAndShade = 0.599993896298105
Set rng = wks.Cells(1, 6)
rng.Value = "CATEGORY"
rng.Font.Name = "Cambria"
rng.Font.Size = 12
rng.Font.Bold = True
rng.Interior.ThemeColor = xlThemeColorLight2
rng.Interior.TintAndShade = 0.599993896298105
Set rng = wks.Cells(1, 7)
rng.Value = "OWNER"
rng.Font.Name = "Cambria"
rng.Font.Size = 12
rng.Font.Bold = True
rng.Interior.ThemeColor = xlThemeColorLight2
rng.Interior.TintAndShade = 0.599993896298105
Set rng = wks.Cells(1, 8)
rng.Value = "REMARK"
rng.Font.Name = "Cambria"
rng.Font.Size = 12
rng.Font.Bold = True
rng.Interior.ThemeColor = xlThemeColorLight2
rng.Interior.TintAndShade = 0.599993896298105
appExcel.Range("A1").Select
appExcel.Range("A1:D1").Borders.LineStyle = xlContinuous
appExcel.Range("A:A").ColumnWidth = 11
appExcel.Range("B:B").ColumnWidth = 60
appExcel.Range("C:C").ColumnWidth = 14
appExcel.Range("D:D").ColumnWidth = 10
appExcel.Range("E:E").ColumnWidth = 9
appExcel.Range("F:F").ColumnWidth = 13
appExcel.Range("G:G").ColumnWidth = 11
appExcel.Range("G:G").ColumnWidth = 10
appExcel.ActiveWindow.SplitColumn = 0
appExcel.ActiveWindow.SplitRow = 1
appExcel.ActiveWindow.FreezePanes = True
With appExcel.Columns("D:D").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="PROD,NON-PROD"
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
With appExcel.Columns("F:F").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="Data-Analysis,Processing,Data-Req,Tactical"
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
If appExcel.Application.WorksheetFunction.CountA(wks.Cells) <> 0 Then
intRowCounter = wks.Cells.Find(What:="*", _
After:=wks.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
intRowCounter = 1
End If
'OUTLOOK EXPORT
For Each itm In fld.Items
intColumnCounter = 2
If TypeOf itm Is MailItem Then
Set msg = itm
If (Format(msg.SentOn, "yy/mm/dd") < StartDate) Then
Exit For
End If
If (((msg.SenderName = "Anusha, Maddineni [CCC-OT_IT NE]") Or _
(msg.SenderName = "Singh, Vinay Kumar1 [CCC-OT_IT NE]") Or _
(msg.SenderName = "Pillai, Sajith [CCC-OT_IT NE]") Or _
(msg.SenderName = "Battini, Bhanu Chandrika [CCC-OT_IT NE]") Or _
(msg.SenderName = "Babu, Tarun [CCC-OT_IT NE]") Or _
(msg.SenderName = "Gonuguntla, Ganesh [CCC-OT_IT NE]") Or _
(msg.SenderName = "Manoharan, Pugazhendhi [CCC-OT_IT NE]") Or _
(msg.SenderName = "Tammaneni, Vishnu Vardana [CCC-OT_IT NE]") Or _
(msg.SenderName = "Karri, Prasada [CCC-OT_IT NE]") Or _
(msg.SenderName = "Ramadass, Praveenkumar [CCC-OT_IT NE]")) And _
(Format(msg.SentOn, "yy/mm/dd") >= StartDate) And _
(Left(msg.Subject, 13) <> "Status Report") And _
(Left(msg.Subject, 19) <> "Missed conversation") And _
(Left(msg.Subject, 9) <> "Task list") And _
(Left(msg.Subject, 8) <> "Tasklist")) Then
intRowCounter = intRowCounter + 1
'SUBJECT COLUMN (ISSUE)
Set rng = wks.Cells(intRowCounter, intColumnCounter)
subjectcont = msg.Subject
subjL = Len(msg.Subject) - 3
subj = Left(subjectcont, 3)
'RE & FW REMOVAL
If ((UCase(subj) = "RE:") Or (UCase(subj) = "FW:")) Then
subjectcont = Mid(msg.Subject, 5, subjL)
Else
subjectcont = msg.Subject
End If
skip_flag = 0
'DUPLICATE CHECK FOR SUBJECT
For dupchk = 1 To intRowCounter
Set rng1 = wks.Cells(dupchk, intColumnCounter)
If (rng1.Value = subjectcont) Then
skip_flag = 1
intRowCounter = intRowCounter - 1
Exit For
Else
skip_flag = 0
End If
Next
If (skip_flag = 0) Then
rng.Value = subjectcont
'DATE COLUMN
intColumnCounter = intColumnCounter - 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = Format(msg.SentOn, "dd-mmm-yyyy")
intColumnCounter = intColumnCounter + 2
Set rng = wks.Cells(intRowCounter, intColumnCounter)
RE.Pattern = "(INC\d{10})"
RE.Global = True
Set allMatches = RE.Execute(msg.Body)
If allMatches.Count <> 0 Then
result = allMatches.Item(0).submatches.Item(0)
Else
result = " "
End If
rng.Value = result
'SENDER COLUMN(OWNER)
intColumnCounter = intColumnCounter + 4
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.SenderName
'BLANK REMARK
intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = " "
End If
End If
End If
Next itm
appExcel.UserControl = True
wkb.Close savechanges:=True
Set rng = Nothing
Set rng1 = Nothing
Set wks = Nothing
Set wkb = Nothing
appExcel.Quit
MsgBox ("Completed !!!")
Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set rng = Nothing
Set rng1 = Nothing
Set msg = Nothing
Set nms = Nothing
Set fld = Nothing
Set itm = Nothing
Set allMatches = Nothing
Set RE = Nothing
Exit Sub
ErrHandler: If Err.Number = 1004 Then
MsgBox strSheet & " doesn't exist", vbOKOnly, "Error"
Else
MsgBox Err.Number & "; Description: ", vbOKOnly, "Error"
End If
Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set rng = Nothing
Set rng1 = Nothing
Set msg = Nothing
Set nms = Nothing
Set fld = Nothing
Set itm = Nothing
Set allMatches = Nothing
Set RE = Nothing
End Sub
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
Regards,
Ganesh G.
