Please see if you can resolve the below code..It used to run perfect,
but now fails the last statement:
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)
Thanks in advance
Dii
but now fails the last statement:
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)
Thanks in advance
Dii