Macro Problems in excel 2007

K

KK

Private Sub cbFile_Click()

'returns your full file name.
File_Name = Application.GetOpenFilename("MS Access Files (*.mdb),*.mdb")

'hence no len, no name...
If Len(File_Name) = 0 Then Exit Sub

tbFile.Value = File_Name

End Sub
Private Sub cbStart_Click()
'Start processing the project file

Dim sGate(14)
Dim iActCodes(14)

sGate(0) = "M11 - Solution Lockdown"
sGate(1) = "M10 - Project Initiation"
sGate(2) = "M09 - Requirements Baselined"
sGate(3) = "M08 - System Requirements Allocated"
sGate(4) = "M07 - Contract Book Baselined & Approved"
sGate(5) = "M06 - Design Readiness"
sGate(6) = "M05 - System Test Readiness"
sGate(7) = "M04a - Ready for Field Test"
sGate(8) = "M04b - Support Materials Released"
sGate(9) = "M04c - Beta Testing"
sGate(10) = "M03 - Ready for Controlled Introduction"
sGate(11) = "M02 - Volume Deployment"
sGate(12) = "System Test Start"
sGate(13) = "Alpha Test Start"
sGate(14) = "Beta Test Start"

iActCodes(0) = 35345 'M11 Activity Code
iActCodes(1) = 35344 'M10 Activity Code
iActCodes(2) = 35347 'M09 Activity Code
iActCodes(3) = 35346 'M08 Activity Code
iActCodes(4) = 35330 'M07 Activity Code
iActCodes(5) = 35331 'M06 Activity Code
iActCodes(6) = 35332 'M05 Activity Code
iActCodes(7) = 125433 'M04a Activity Code
iActCodes(8) = 125434 'M04b Activity Code
iActCodes(9) = 125435 'M04c Activity Code
iActCodes(10) = 35326 'M03 Activity Code
iActCodes(11) = 35327 'M02 Activity Code
iActCodes(12) = 59001 '
iActCodes(13) = 59002 '
iActCodes(14) = 59003 '


Dim sql As String
Dim rs As ADODB.Recordset
Dim conData As ADODB.Connection

Set conData = CreateObject("ADODB.Connection")
conData.ConnectionTimeout = 30

conData.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & tbFile)

sql = "SELECT TaskID, TaskName, TaskDuration, TaskStart, TaskFinish,
TaskMilestone, TaskSummary,"
sql = sql & " TaskPredecessors, TaskSuccessors, TaskDurationElapsed,
TaskPercentComplete FROM Tasks"
sql = sql & " Where TaskSummary=0 and TaskMilestone=0 and
TaskDuration > 48000 and TaskPercentComplete<100"
sql = sql & " Order by TaskID"

Set rs = CreateObject("ADODB.Recordset")

rs.Open sql, conData

'Worksheets.Add.Activate
Sheets("Duration Test").Activate
ActiveSheet.UsedRange.Select
Selection.EntireRow.Delete

Duration_Test_Cnt = 0

'Create Column Headers
ActiveSheet.Cells(4, 1).Value = "ID"
ActiveSheet.Cells(4, 2).Value = "Task"
ActiveSheet.Cells(4, 3).Value = "Duration"
ActiveSheet.Cells(4, 4).Value = "Start Date"
ActiveSheet.Cells(4, 5).Value = "Finish Date"

j = 5 'start data in row 5

Do While Not rsData.EOF
If rsData("TaskDurationElapsed") Then
duration_calc = 14400
Else
duration_calc = 4800
End If

ActiveSheet.Cells(j, 1).Value = rsData("TaskID")
ActiveSheet.Cells(j, 2).Value = rsData("TaskName")
ActiveSheet.Cells(j, 3).Value = (rsData("TaskDuration") /
duration_calc)
ActiveSheet.Cells(j, 4).Value = rsData("TaskStart")
ActiveSheet.Cells(j, 5).Value = rsData("TaskFinish")
j = j + 1
Duration_Test_Cnt = Duration_Test_Cnt + 1
rsData.MoveNext
Loop

If j = 5 Then 'No data was selected
ActiveSheet.Cells(j, 2).Value = "NO TASKS TO REPORT"
ActiveSheet.Cells(j, 2).Font.Bold = True
End If

ActiveSheet.Cells.Select
ActiveSheet.UsedRange.Columns.AutoFit
Selection.Font.Size = 8

ActiveSheet.Columns("B").ColumnWidth = 50
ActiveSheet.Columns("A").HorizontalAlignment = xlCenter
ActiveSheet.Columns("C").NumberFormat = "0.0"

ActiveSheet.Range("D3:E" & j).Select
Selection.NumberFormat = "mm/dd/yyyy"
Selection.HorizontalAlignment = xlCenter
ActiveSheet.Range("B1").Select

ActiveSheet.Cells(2, 2).Value = "Test Completed : " &
FormatDateTime(Now())
ActiveSheet.Cells(2, 2).Font.Bold = True

ActiveSheet.Cells(1, 2).Value = "File : " & tbFile.Value
ActiveSheet.Cells(1, 2).Font.Bold = True

'********************************************************************************************************
'*** locate tasks with deadlines
'********************************************************************************************************

sql = "SELECT TaskID, TaskName, TaskDuration, TaskStart, TaskFinish,
TaskMilestone, TaskSummary,"
sql = sql & " TaskPredecessors, TaskSuccessors,
TaskDurationElapsed,TaskPercentComplete FROM Tasks"
sql = sql & " Where TaskSummary=0 and TaskDeadline <> 'NA' and
TaskPercentComplete<100"
sql = sql & " Order by TaskID"
Set rsData = conData.Execute(sql)

'Worksheets.Add.Activate
Sheets("Deadlines").Activate
ActiveSheet.UsedRange.Select
Selection.EntireRow.Delete

'Create Column Headers
ActiveSheet.Cells(4, 1).Value = "ID"
ActiveSheet.Cells(4, 2).Value = "Task"
ActiveSheet.Cells(4, 3).Value = "Duration"
ActiveSheet.Cells(4, 4).Value = "Start Date"
ActiveSheet.Cells(4, 5).Value = "Finish Date"

j = 5 'start data in row 5

Do While Not rsData.EOF
If rsData("TaskDurationElapsed") Then
duration_calc = 14400
Else
duration_calc = 4800
End If

ActiveSheet.Cells(j, 1).Value = rsData("TaskID")
ActiveSheet.Cells(j, 2).Value = rsData("TaskName")
ActiveSheet.Cells(j, 3).Value = (rsData("TaskDuration") /
duration_calc)
ActiveSheet.Cells(j, 4).Value = rsData("TaskStart")
ActiveSheet.Cells(j, 5).Value = rsData("TaskFinish")
j = j + 1
rsData.MoveNext
Loop

If j = 5 Then 'No data was selected
ActiveSheet.Cells(j, 2).Value = "NO TASKS TO REPORT"
ActiveSheet.Cells(j, 2).Font.Bold = True
End If

ActiveSheet.Cells.Select
ActiveSheet.UsedRange.Columns.AutoFit
Selection.Font.Size = 8

ActiveSheet.Columns("B").ColumnWidth = 50
ActiveSheet.Columns("A").HorizontalAlignment = xlCenter
ActiveSheet.Columns("C").NumberFormat = "0.0"

ActiveSheet.Range("D3:E" & j).Select
Selection.NumberFormat = "mm/dd/yyyy"
Selection.HorizontalAlignment = xlCenter
ActiveSheet.Range("B1").Select

ActiveSheet.Cells(2, 2).Value = "Test Completed : " &
FormatDateTime(Now())
ActiveSheet.Cells(2, 2).Font.Bold = True

ActiveSheet.Cells(1, 2).Value = "File : " & tbFile.Value
ActiveSheet.Cells(1, 2).Font.Bold = True



When i debug , stop at [ [rs.Open sql, conData] ].I had used MS project
generated one database file , i try to use excel 2007 to analysis the data,
but fail .Before i had tried used the MS project to generated one OLAP cube
..But also debug stop at [ [rs.Open sql, conData] ].Anyone can help me....
 
J

Joel

I think the problem is the Where and " Order by TaskID" needs to be in a new
lines. You may need to add a vbcrlf.

Tried simplifying your SQL to see where the problem is located.

One trick I use is to start a macro recorder. The add a query and manually
select the options you need. The take the command text portion of the query
from the recorded macro. Other tricks is to edit a query and manually change
the SQL portion of the query. Create a simple query. Then edit the query
and go to the SQL option in the edit query. Add one option at a time to the
query. If you have an error in the option you will immediately get an error.

KK said:
Private Sub cbFile_Click()

'returns your full file name.
File_Name = Application.GetOpenFilename("MS Access Files (*.mdb),*.mdb")

'hence no len, no name...
If Len(File_Name) = 0 Then Exit Sub

tbFile.Value = File_Name

End Sub
Private Sub cbStart_Click()
'Start processing the project file

Dim sGate(14)
Dim iActCodes(14)

sGate(0) = "M11 - Solution Lockdown"
sGate(1) = "M10 - Project Initiation"
sGate(2) = "M09 - Requirements Baselined"
sGate(3) = "M08 - System Requirements Allocated"
sGate(4) = "M07 - Contract Book Baselined & Approved"
sGate(5) = "M06 - Design Readiness"
sGate(6) = "M05 - System Test Readiness"
sGate(7) = "M04a - Ready for Field Test"
sGate(8) = "M04b - Support Materials Released"
sGate(9) = "M04c - Beta Testing"
sGate(10) = "M03 - Ready for Controlled Introduction"
sGate(11) = "M02 - Volume Deployment"
sGate(12) = "System Test Start"
sGate(13) = "Alpha Test Start"
sGate(14) = "Beta Test Start"

iActCodes(0) = 35345 'M11 Activity Code
iActCodes(1) = 35344 'M10 Activity Code
iActCodes(2) = 35347 'M09 Activity Code
iActCodes(3) = 35346 'M08 Activity Code
iActCodes(4) = 35330 'M07 Activity Code
iActCodes(5) = 35331 'M06 Activity Code
iActCodes(6) = 35332 'M05 Activity Code
iActCodes(7) = 125433 'M04a Activity Code
iActCodes(8) = 125434 'M04b Activity Code
iActCodes(9) = 125435 'M04c Activity Code
iActCodes(10) = 35326 'M03 Activity Code
iActCodes(11) = 35327 'M02 Activity Code
iActCodes(12) = 59001 '
iActCodes(13) = 59002 '
iActCodes(14) = 59003 '


Dim sql As String
Dim rs As ADODB.Recordset
Dim conData As ADODB.Connection

Set conData = CreateObject("ADODB.Connection")
conData.ConnectionTimeout = 30

conData.Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & tbFile)

sql = "SELECT TaskID, TaskName, TaskDuration, TaskStart, TaskFinish,
TaskMilestone, TaskSummary,"
sql = sql & " TaskPredecessors, TaskSuccessors, TaskDurationElapsed,
TaskPercentComplete FROM Tasks"
sql = sql & " Where TaskSummary=0 and TaskMilestone=0 and
TaskDuration > 48000 and TaskPercentComplete<100"
sql = sql & " Order by TaskID"

Set rs = CreateObject("ADODB.Recordset")

rs.Open sql, conData

'Worksheets.Add.Activate
Sheets("Duration Test").Activate
ActiveSheet.UsedRange.Select
Selection.EntireRow.Delete

Duration_Test_Cnt = 0

'Create Column Headers
ActiveSheet.Cells(4, 1).Value = "ID"
ActiveSheet.Cells(4, 2).Value = "Task"
ActiveSheet.Cells(4, 3).Value = "Duration"
ActiveSheet.Cells(4, 4).Value = "Start Date"
ActiveSheet.Cells(4, 5).Value = "Finish Date"

j = 5 'start data in row 5

Do While Not rsData.EOF
If rsData("TaskDurationElapsed") Then
duration_calc = 14400
Else
duration_calc = 4800
End If

ActiveSheet.Cells(j, 1).Value = rsData("TaskID")
ActiveSheet.Cells(j, 2).Value = rsData("TaskName")
ActiveSheet.Cells(j, 3).Value = (rsData("TaskDuration") /
duration_calc)
ActiveSheet.Cells(j, 4).Value = rsData("TaskStart")
ActiveSheet.Cells(j, 5).Value = rsData("TaskFinish")
j = j + 1
Duration_Test_Cnt = Duration_Test_Cnt + 1
rsData.MoveNext
Loop

If j = 5 Then 'No data was selected
ActiveSheet.Cells(j, 2).Value = "NO TASKS TO REPORT"
ActiveSheet.Cells(j, 2).Font.Bold = True
End If

ActiveSheet.Cells.Select
ActiveSheet.UsedRange.Columns.AutoFit
Selection.Font.Size = 8

ActiveSheet.Columns("B").ColumnWidth = 50
ActiveSheet.Columns("A").HorizontalAlignment = xlCenter
ActiveSheet.Columns("C").NumberFormat = "0.0"

ActiveSheet.Range("D3:E" & j).Select
Selection.NumberFormat = "mm/dd/yyyy"
Selection.HorizontalAlignment = xlCenter
ActiveSheet.Range("B1").Select

ActiveSheet.Cells(2, 2).Value = "Test Completed : " &
FormatDateTime(Now())
ActiveSheet.Cells(2, 2).Font.Bold = True

ActiveSheet.Cells(1, 2).Value = "File : " & tbFile.Value
ActiveSheet.Cells(1, 2).Font.Bold = True

'********************************************************************************************************
'*** locate tasks with deadlines
'********************************************************************************************************

sql = "SELECT TaskID, TaskName, TaskDuration, TaskStart, TaskFinish,
TaskMilestone, TaskSummary,"
sql = sql & " TaskPredecessors, TaskSuccessors,
TaskDurationElapsed,TaskPercentComplete FROM Tasks"
sql = sql & " Where TaskSummary=0 and TaskDeadline <> 'NA' and
TaskPercentComplete<100"
sql = sql & " Order by TaskID"
Set rsData = conData.Execute(sql)

'Worksheets.Add.Activate
Sheets("Deadlines").Activate
ActiveSheet.UsedRange.Select
Selection.EntireRow.Delete

'Create Column Headers
ActiveSheet.Cells(4, 1).Value = "ID"
ActiveSheet.Cells(4, 2).Value = "Task"
ActiveSheet.Cells(4, 3).Value = "Duration"
ActiveSheet.Cells(4, 4).Value = "Start Date"
ActiveSheet.Cells(4, 5).Value = "Finish Date"

j = 5 'start data in row 5

Do While Not rsData.EOF
If rsData("TaskDurationElapsed") Then
duration_calc = 14400
Else
duration_calc = 4800
End If

ActiveSheet.Cells(j, 1).Value = rsData("TaskID")
ActiveSheet.Cells(j, 2).Value = rsData("TaskName")
ActiveSheet.Cells(j, 3).Value = (rsData("TaskDuration") /
duration_calc)
ActiveSheet.Cells(j, 4).Value = rsData("TaskStart")
ActiveSheet.Cells(j, 5).Value = rsData("TaskFinish")
j = j + 1
rsData.MoveNext
Loop

If j = 5 Then 'No data was selected
ActiveSheet.Cells(j, 2).Value = "NO TASKS TO REPORT"
ActiveSheet.Cells(j, 2).Font.Bold = True
End If

ActiveSheet.Cells.Select
ActiveSheet.UsedRange.Columns.AutoFit
Selection.Font.Size = 8

ActiveSheet.Columns("B").ColumnWidth = 50
ActiveSheet.Columns("A").HorizontalAlignment = xlCenter
ActiveSheet.Columns("C").NumberFormat = "0.0"

ActiveSheet.Range("D3:E" & j).Select
Selection.NumberFormat = "mm/dd/yyyy"
Selection.HorizontalAlignment = xlCenter
ActiveSheet.Range("B1").Select

ActiveSheet.Cells(2, 2).Value = "Test Completed : " &
FormatDateTime(Now())
ActiveSheet.Cells(2, 2).Font.Bold = True

ActiveSheet.Cells(1, 2).Value = "File : " & tbFile.Value
ActiveSheet.Cells(1, 2).Font.Bold = True



When i debug , stop at [ [rs.Open sql, conData] ].I had used MS project
generated one database file , i try to use excel 2007 to analysis the data,
but fail .Before i had tried used the MS project to generated one OLAP cube
.But also debug stop at [ [rs.Open sql, conData] ].Anyone can help me....
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Cannot initialize Microsoft@ SQL analysis services 0
Follow Hyperlink in Excel 2007 0
A Better Way to Reorganize Data? 5
Please Help! Need to add a Variable Range in my Excel Macro withPivot Tables 3
Help with speeding up macro 5
type mismatch error in macro in excel 0
Convert macro that runs against entire column to run in current row 2
Macro Error Please help 3

Top