Excel Macro error

[dii jii]

Hi,


We have macro to extract the subject line from outlook mail folders..


It used to work ok..But for some reason now it errors out on this
line:


*Set ns = Application.Session*


iGrandRow = 2


Set wsCsd = wb.Worksheets(Tabnum1)


And here is the error messege:


“Object doesn’t support this property or method (Error 438)”


We have only this references :


Visual basic for application


Ms Excel 11:0 Object library


OLE Automation


Ms Office 11:0 object library


Outlook 11:00 object library..


Please let me know if we are missing any other object..


Thanks in advance.

 

[Javed]

This line is wrong:

Set ns = Application.Session*

this line will vary depending on the Host (Oulook or Excel)

 

[dii jii]

This line is wrong:

Set ns = Application.Session*

this line will vary depending on the Host (Oulook  or Excel)

Javed,
The host is excel in our case...Pls suggest the changes.
Thanks

 

[Javed]

Sub MailSubj()

Dim ns As Namespace, ol As New Outlook.Application, mi As MailItem, FL
As Outlook.Folder
Dim i As Long

Set ns = ol.GetNamespace("MAPI")

'Prompts for selecting mail folder
Set FL = ns.PickFolder

i = 0

'adds sheet fro recording data
Worksheets.Add

'looping for getting subject of each mail

For Each mi In FL.Items
i = i + 1
Cells(i, 1).Value = mi.Subject
Next mi

End Sub

 

[dii jii]

Sub MailSubj()

Dim ns As Namespace, ol As New Outlook.Application, mi As MailItem, FL
As Outlook.Folder
Dim i As Long

Set ns = ol.GetNamespace("MAPI")

'Prompts for selecting mail folder
Set FL = ns.PickFolder

i = 0

'adds sheet fro recording data
Worksheets.Add

'looping for getting subject of each mail

For Each mi In FL.Items
    i = i + 1
    Cells(i, 1).Value = mi.Subject
Next mi

End Sub

Thanlks..
Here is the actual code...
Sub patron_RetrieveData()

Dim ns As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
Dim itm As Object
Dim msg As Outlook.MailItem
Dim ex As Excel.Application
Dim filePreMD As String, fileCurMD As String, fileSupport As
String
Dim wb As Excel.Workbook, wbSupport As Excel.Workbook
Dim ws As Excel.Worksheet, wsCsd As Excel.Worksheet
Dim iRow As Integer, iGrandRow As Integer

Dim curMon As String, strMonInFolder As String, curDate As Date
Dim arrFd() As String
Dim iFd As Integer
Dim NewSbj As allFinal

Dim arrType() As String

'On Error Resume Next
'
curMon = InputBox("Current Month, YYMM", "Month",
Format(DateAdd("m", -1, Now), "YYMM"))
If CheckYYMM(curMon) = False Then MsgBox "Involid format of month.
Please check and run it again.", vbCritical + vbOKCancel, "Materdata":
Exit Sub
strMonInFolder = InputBox("Current month used in folders' names",
"Month", Format(DateAdd("m", -1, Now), "mmmm"))
Set ex = CreateObject("Excel.Application")
filePreMD = ex.GetOpenFilename("Excel Files (*.xls), *.xls", ,
"Last Month's patron file (to be used as the template)")
If filePreMD = "False" Then Exit Sub
Set wb = ex.Workbooks.Open(filePreMD, 0, True)
fileCurMD = ex.GetSaveAsFilename("", "Excel Files (*.xls),
*.xls", , "This Month's patron file (will be created if doesn't
exist)")
If fileCurMD = "False" Then Exit Sub
wb.SaveAs fileCurMD

fileSupport = ex.GetOpenFilename("Excel Files (*.xls), *.xls", ,
"Support file that contains both data tab and result tab")
If fileSupport = "False" Then Exit Sub

ex.Visible = True
ex.WindowState = xlMinimized
CleanupAndReset wb
arrType = Split(VolidType, ";")
' arrExclType = Split(ExcludedType, ";")

Set ns = Application.Session ' ################ERROR start
here###############
iGrandRow = 2
Set wsCsd = wb.Worksheets(TabConsld)

 

[Javed]

Thanlks..
Here is the actual code...
Sub patron_RetrieveData()

    Dim ns As Outlook.NameSpace
    Dim fld As Outlook.MAPIFolder
    Dim itm As Object
    Dim msg As Outlook.MailItem
    Dim ex As Excel.Application
    Dim filePreMD As String, fileCurMD As String, fileSupport As
String
    Dim wb As Excel.Workbook, wbSupport As Excel.Workbook
    Dim ws As Excel.Worksheet, wsCsd As Excel.Worksheet
    Dim iRow As Integer, iGrandRow As Integer

    Dim curMon As String, strMonInFolder As String, curDate As Date
    Dim arrFd() As String
    Dim iFd As Integer
    Dim NewSbj As allFinal

    Dim arrType() As String

    'On Error Resume Next
    '
    curMon = InputBox("Current Month, YYMM", "Month",
Format(DateAdd("m", -1, Now), "YYMM"))
    If CheckYYMM(curMon) = False Then MsgBox "Involid format of month.
Please check and run it again.", vbCritical + vbOKCancel, "Materdata":
Exit Sub
    strMonInFolder = InputBox("Current month used in folders' names",
"Month", Format(DateAdd("m", -1, Now), "mmmm"))
    Set ex = CreateObject("Excel.Application")
    filePreMD = ex.GetOpenFilename("Excel Files (*.xls), *.xls", ,
"Last Month's patron file (to be used as the template)")
    If filePreMD = "False" Then Exit Sub
    Set wb = ex.Workbooks.Open(filePreMD, 0, True)
    fileCurMD = ex.GetSaveAsFilename("", "Excel Files (*.xls),
*.xls", , "This Month's patron file (will be created if doesn't
exist)")
    If fileCurMD = "False" Then Exit Sub
    wb.SaveAs fileCurMD

    fileSupport = ex.GetOpenFilename("Excel Files (*.xls), *.xls", ,
"Support file that contains both data tab and  result tab")
    If fileSupport = "False" Then Exit Sub

    ex.Visible = True
    ex.WindowState = xlMinimized
    CleanupAndReset wb
    arrType = Split(VolidType, ";")
'    arrExclType = Split(ExcludedType, ";")

    Set ns = Application.Session  ' ################ERROR start
here###############
    iGrandRow = 2
    Set wsCsd = wb.Worksheets(TabConsld)- Hide quoted text -

- Show quoted text -

Dear It is not clear whether problem solved or not.As you have put
code do you want me to update accordingly ?
However it seems that the code is half.Can you give full code.

I feel that you can incorporate necessary changes.