Hi,

My application hangs in the below code, I am getting data from a recordeset
and the displaying the data in a PowerPoint that is generated from the
application....

Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSld As PowerPoint.Slide

Set pptApp = New PowerPoint.Application
Set pptPres = pptApp.Presentations.Add

Set pptSld = pptPres.Slides.Add(1,ppLayoutText)

Dim rstAccomp As ADODB.Recordset
Set rstAccomp = New ADODB.Recordset

Dim strSQL As String

Dim StartDate As Date
Dim EndDate As Date

StartDate = Format$(Date,"Short Date")
EndDate = Format$(Date,"Short Date")

strSQL ="SELECT DISTINCT Accomplishment, DDate FROM tblAccomplishment WHERE
ProgramIpt = '" & SelectedIpt & "' AND DDate Between " & Format(StartDate,
"\#mm\/dd\/yyyy\#") & " AND " & Format(EndDate,"\#mm\/dd\/yyyy\#")


With rstAccomp
.Open strSQL, CurrentProject.Connection, adOpenStatic, adLockPessimistic
if rstAccomp.BOF And rstAccomp.EOF Then
MsgBox "No DATA IN the recordset", vbCritical, Error
strText = "None"
Else
.MoveFirst
Do Until .EOF
strText = .Fields("Accomplishment") & vbTab & .Fields("DDate") & vbCrLf
Loop
End If
End With

rstAccomp.Close
Set rstAccomp = Nothing

With pptSld.Shapes(2).TextFrame.TextRange
..text = "Accomplishment: " & vbCrLf & vbTab & strText & vbCrLf

With .Font
..Name = "Arial"
..Bold = True
..Size = 13
End With
End With

pptApp.Activate
pptApp.Visible = True
pptPres.SlideShowSettings.Run

Set pptApp = Nothing
Set pptPres = Nothing

Application.Screen.MousePointer = 0

Please note this group is closing soon, so the project.developer group is
preferred. However, where is the code failing? Press Ctrl+Break to get the
End or Debug dialog. Click Debug and tell us where the code is stuck.

You could also enter the following into the Immediate window then press
Enter.

? "SELECT DISTINCT Accomplishment, DDate FROM tblAccomplishment WHERE
ProgramIpt = '" & SelectedIpt & "' AND DDate Between " & Format(StartDate,
"\#mm\/dd\/yyyy\#") & " AND " & Format(EndDate,"\#mm\/dd\/yyyy\#")

Copy paste teh resultant string into an Access query's SQL window and
confirm teh SQL code is valid.
--

Rod Gill
Project MVP
Visit www.msproject-systems.com for Project Companion Tools and more


"tiger" <aaa0715@omega.uta.edu> wrote in message
news:%23m%23WkNSKGHA.1192@TK2MSFTNGP11.phx.gbl...
> Hi,
>
> My application hangs in the below code, I am getting data from a
> recordeset and the displaying the data in a PowerPoint that is generated
> from the application....
>
> Dim pptApp As PowerPoint.Application
> Dim pptPres As PowerPoint.Presentation
> Dim pptSld As PowerPoint.Slide
>
> Set pptApp = New PowerPoint.Application
> Set pptPres = pptApp.Presentations.Add
>
> Set pptSld = pptPres.Slides.Add(1,ppLayoutText)
>
> Dim rstAccomp As ADODB.Recordset
> Set rstAccomp = New ADODB.Recordset
>
> Dim strSQL As String
>
> Dim StartDate As Date
> Dim EndDate As Date
>
> StartDate = Format$(Date,"Short Date")
> EndDate = Format$(Date,"Short Date")
>
> strSQL ="SELECT DISTINCT Accomplishment, DDate FROM tblAccomplishment
> WHERE
> ProgramIpt = '" & SelectedIpt & "' AND DDate Between " & Format(StartDate,
> "\#mm\/dd\/yyyy\#") & " AND " & Format(EndDate,"\#mm\/dd\/yyyy\#")
>
>
> With rstAccomp
> .Open strSQL, CurrentProject.Connection, adOpenStatic, adLockPessimistic
> if rstAccomp.BOF And rstAccomp.EOF Then
> MsgBox "No DATA IN the recordset", vbCritical, Error
> strText = "None"
> Else
> .MoveFirst
> Do Until .EOF
> strText = .Fields("Accomplishment") & vbTab & .Fields("DDate") & vbCrLf
> Loop
> End If
> End With
>
> rstAccomp.Close
> Set rstAccomp = Nothing
>
> With pptSld.Shapes(2).TextFrame.TextRange
> .text = "Accomplishment: " & vbCrLf & vbTab & strText & vbCrLf
>
> With .Font
> .Name = "Arial"
> .Bold = True
> .Size = 13
> End With
> End With
>
> pptApp.Activate
> pptApp.Visible = True
> pptPres.SlideShowSettings.Run
>
> Set pptApp = Nothing
> Set pptPres = Nothing
>
> Application.Screen.MousePointer = 0
>

Within your Do Until loop you need a MoveNext. That is where the code is
hanging - it is working on the first record over and over.
Hope this helps,
Rick Williams

"tiger" <aaa0715@omega.uta.edu> wrote in message
news:%23m%23WkNSKGHA.1192@TK2MSFTNGP11.phx.gbl...
> Hi,
>
> My application hangs in the below code, I am getting data from a
> recordeset and the displaying the data in a PowerPoint that is generated
> from the application....
>
> Dim pptApp As PowerPoint.Application
> Dim pptPres As PowerPoint.Presentation
> Dim pptSld As PowerPoint.Slide
>
> Set pptApp = New PowerPoint.Application
> Set pptPres = pptApp.Presentations.Add
>
> Set pptSld = pptPres.Slides.Add(1,ppLayoutText)
>
> Dim rstAccomp As ADODB.Recordset
> Set rstAccomp = New ADODB.Recordset
>
> Dim strSQL As String
>
> Dim StartDate As Date
> Dim EndDate As Date
>
> StartDate = Format$(Date,"Short Date")
> EndDate = Format$(Date,"Short Date")
>
> strSQL ="SELECT DISTINCT Accomplishment, DDate FROM tblAccomplishment
> WHERE
> ProgramIpt = '" & SelectedIpt & "' AND DDate Between " & Format(StartDate,
> "\#mm\/dd\/yyyy\#") & " AND " & Format(EndDate,"\#mm\/dd\/yyyy\#")
>
>
> With rstAccomp
> .Open strSQL, CurrentProject.Connection, adOpenStatic, adLockPessimistic
> if rstAccomp.BOF And rstAccomp.EOF Then
> MsgBox "No DATA IN the recordset", vbCritical, Error
> strText = "None"
> Else
> .MoveFirst
> Do Until .EOF
> strText = .Fields("Accomplishment") & vbTab & .Fields("DDate") & vbCrLf
> Loop
> End If
> End With
>
> rstAccomp.Close
> Set rstAccomp = Nothing
>
> With pptSld.Shapes(2).TextFrame.TextRange
> .text = "Accomplishment: " & vbCrLf & vbTab & strText & vbCrLf
>
> With .Font
> .Name = "Arial"
> .Bold = True
> .Size = 13
> End With
> End With
>
> pptApp.Activate
> pptApp.Visible = True
> pptPres.SlideShowSettings.Run
>
> Set pptApp = Nothing
> Set pptPres = Nothing
>
> Application.Screen.MousePointer = 0
>

Within your Do Until loop you need a MoveNext. That is where the code is
hanging - it is working on the first record over and over.
Hope this helps,
Rick Williams

"tiger" <aaa0715@omega.uta.edu> wrote in message
news:%23m%23WkNSKGHA.1192@TK2MSFTNGP11.phx.gbl...
> Hi,
>
> My application hangs in the below code, I am getting data from a
> recordeset and the displaying the data in a PowerPoint that is generated
> from the application....
>
> Dim pptApp As PowerPoint.Application
> Dim pptPres As PowerPoint.Presentation
> Dim pptSld As PowerPoint.Slide
>
> Set pptApp = New PowerPoint.Application
> Set pptPres = pptApp.Presentations.Add
>
> Set pptSld = pptPres.Slides.Add(1,ppLayoutText)
>
> Dim rstAccomp As ADODB.Recordset
> Set rstAccomp = New ADODB.Recordset
>
> Dim strSQL As String
>
> Dim StartDate As Date
> Dim EndDate As Date
>
> StartDate = Format$(Date,"Short Date")
> EndDate = Format$(Date,"Short Date")
>
> strSQL ="SELECT DISTINCT Accomplishment, DDate FROM tblAccomplishment
> WHERE
> ProgramIpt = '" & SelectedIpt & "' AND DDate Between " & Format(StartDate,
> "\#mm\/dd\/yyyy\#") & " AND " & Format(EndDate,"\#mm\/dd\/yyyy\#")
>
>
> With rstAccomp
> .Open strSQL, CurrentProject.Connection, adOpenStatic, adLockPessimistic
> if rstAccomp.BOF And rstAccomp.EOF Then
> MsgBox "No DATA IN the recordset", vbCritical, Error
> strText = "None"
> Else
> .MoveFirst
> Do Until .EOF
> strText = .Fields("Accomplishment") & vbTab & .Fields("DDate") & vbCrLf
> Loop
> End If
> End With
>
> rstAccomp.Close
> Set rstAccomp = Nothing
>
> With pptSld.Shapes(2).TextFrame.TextRange
> .text = "Accomplishment: " & vbCrLf & vbTab & strText & vbCrLf
>
> With .Font
> .Name = "Arial"
> .Bold = True
> .Size = 13
> End With
> End With
>
> pptApp.Activate
> pptApp.Visible = True
> pptPres.SlideShowSettings.Run
>
> Set pptApp = Nothing
> Set pptPres = Nothing
>
> Application.Screen.MousePointer = 0
>

Within your Do Until loop you need a MoveNext. That is where the code is
hanging - it is working on the first record over and over.
Hope this helps,
Rick Williams

"tiger" <aaa0715@omega.uta.edu> wrote in message
news:%23m%23WkNSKGHA.1192@TK2MSFTNGP11.phx.gbl...
> Hi,
>
> My application hangs in the below code, I am getting data from a
> recordeset and the displaying the data in a PowerPoint that is generated
> from the application....
>
> Dim pptApp As PowerPoint.Application
> Dim pptPres As PowerPoint.Presentation
> Dim pptSld As PowerPoint.Slide
>
> Set pptApp = New PowerPoint.Application
> Set pptPres = pptApp.Presentations.Add
>
> Set pptSld = pptPres.Slides.Add(1,ppLayoutText)
>
> Dim rstAccomp As ADODB.Recordset
> Set rstAccomp = New ADODB.Recordset
>
> Dim strSQL As String
>
> Dim StartDate As Date
> Dim EndDate As Date
>
> StartDate = Format$(Date,"Short Date")
> EndDate = Format$(Date,"Short Date")
>
> strSQL ="SELECT DISTINCT Accomplishment, DDate FROM tblAccomplishment
> WHERE
> ProgramIpt = '" & SelectedIpt & "' AND DDate Between " & Format(StartDate,
> "\#mm\/dd\/yyyy\#") & " AND " & Format(EndDate,"\#mm\/dd\/yyyy\#")
>
>
> With rstAccomp
> .Open strSQL, CurrentProject.Connection, adOpenStatic, adLockPessimistic
> if rstAccomp.BOF And rstAccomp.EOF Then
> MsgBox "No DATA IN the recordset", vbCritical, Error
> strText = "None"
> Else
> .MoveFirst
> Do Until .EOF
> strText = .Fields("Accomplishment") & vbTab & .Fields("DDate") & vbCrLf
> Loop
> End If
> End With
>
> rstAccomp.Close
> Set rstAccomp = Nothing
>
> With pptSld.Shapes(2).TextFrame.TextRange
> .text = "Accomplishment: " & vbCrLf & vbTab & strText & vbCrLf
>
> With .Font
> .Name = "Arial"
> .Bold = True
> .Size = 13
> End With
> End With
>
> pptApp.Activate
> pptApp.Visible = True
> pptPres.SlideShowSettings.Run
>
> Set pptApp = Nothing
> Set pptPres = Nothing
>
> Application.Screen.MousePointer = 0
>

Within your Do Until loop you need a MoveNext. That is where the code is
hanging - it is working on the first record over and over.
Hope this helps,
Rick Williams

"tiger" <aaa0715@omega.uta.edu> wrote in message
news:%23m%23WkNSKGHA.1192@TK2MSFTNGP11.phx.gbl...
> Hi,
>
> My application hangs in the below code, I am getting data from a
> recordeset and the displaying the data in a PowerPoint that is generated
> from the application....
>
> Dim pptApp As PowerPoint.Application
> Dim pptPres As PowerPoint.Presentation
> Dim pptSld As PowerPoint.Slide
>
> Set pptApp = New PowerPoint.Application
> Set pptPres = pptApp.Presentations.Add
>
> Set pptSld = pptPres.Slides.Add(1,ppLayoutText)
>
> Dim rstAccomp As ADODB.Recordset
> Set rstAccomp = New ADODB.Recordset
>
> Dim strSQL As String
>
> Dim StartDate As Date
> Dim EndDate As Date
>
> StartDate = Format$(Date,"Short Date")
> EndDate = Format$(Date,"Short Date")
>
> strSQL ="SELECT DISTINCT Accomplishment, DDate FROM tblAccomplishment
> WHERE
> ProgramIpt = '" & SelectedIpt & "' AND DDate Between " & Format(StartDate,
> "\#mm\/dd\/yyyy\#") & " AND " & Format(EndDate,"\#mm\/dd\/yyyy\#")
>
>
> With rstAccomp
> .Open strSQL, CurrentProject.Connection, adOpenStatic, adLockPessimistic
> if rstAccomp.BOF And rstAccomp.EOF Then
> MsgBox "No DATA IN the recordset", vbCritical, Error
> strText = "None"
> Else
> .MoveFirst
> Do Until .EOF
> strText = .Fields("Accomplishment") & vbTab & .Fields("DDate") & vbCrLf
> Loop
> End If
> End With
>
> rstAccomp.Close
> Set rstAccomp = Nothing
>
> With pptSld.Shapes(2).TextFrame.TextRange
> .text = "Accomplishment: " & vbCrLf & vbTab & strText & vbCrLf
>
> With .Font
> .Name = "Arial"
> .Bold = True
> .Size = 13
> End With
> End With
>
> pptApp.Activate
> pptApp.Visible = True
> pptPres.SlideShowSettings.Run
>
> Set pptApp = Nothing
> Set pptPres = Nothing
>
> Application.Screen.MousePointer = 0
>

Within your Do Until loop you need a MoveNext. That is where the code is
hanging - it is working on the first record over and over.
Hope this helps,
Rick Williams

"tiger" <aaa0715@omega.uta.edu> wrote in message
news:%23m%23WkNSKGHA.1192@TK2MSFTNGP11.phx.gbl...
> Hi,
>
> My application hangs in the below code, I am getting data from a
> recordeset and the displaying the data in a PowerPoint that is generated
> from the application....
>
> Dim pptApp As PowerPoint.Application
> Dim pptPres As PowerPoint.Presentation
> Dim pptSld As PowerPoint.Slide
>
> Set pptApp = New PowerPoint.Application
> Set pptPres = pptApp.Presentations.Add
>
> Set pptSld = pptPres.Slides.Add(1,ppLayoutText)
>
> Dim rstAccomp As ADODB.Recordset
> Set rstAccomp = New ADODB.Recordset
>
> Dim strSQL As String
>
> Dim StartDate As Date
> Dim EndDate As Date
>
> StartDate = Format$(Date,"Short Date")
> EndDate = Format$(Date,"Short Date")
>
> strSQL ="SELECT DISTINCT Accomplishment, DDate FROM tblAccomplishment
> WHERE
> ProgramIpt = '" & SelectedIpt & "' AND DDate Between " & Format(StartDate,
> "\#mm\/dd\/yyyy\#") & " AND " & Format(EndDate,"\#mm\/dd\/yyyy\#")
>
>
> With rstAccomp
> .Open strSQL, CurrentProject.Connection, adOpenStatic, adLockPessimistic
> if rstAccomp.BOF And rstAccomp.EOF Then
> MsgBox "No DATA IN the recordset", vbCritical, Error
> strText = "None"
> Else
> .MoveFirst
> Do Until .EOF
> strText = .Fields("Accomplishment") & vbTab & .Fields("DDate") & vbCrLf
> Loop
> End If
> End With
>
> rstAccomp.Close
> Set rstAccomp = Nothing
>
> With pptSld.Shapes(2).TextFrame.TextRange
> .text = "Accomplishment: " & vbCrLf & vbTab & strText & vbCrLf
>
> With .Font
> .Name = "Arial"
> .Bold = True
> .Size = 13
> End With
> End With
>
> pptApp.Activate
> pptApp.Visible = True
> pptPres.SlideShowSettings.Run
>
> Set pptApp = Nothing
> Set pptPres = Nothing
>
> Application.Screen.MousePointer = 0
>