From: Ken on
Thank you again.

Not sure what is happening as now I'm being prompted for "Output File Name",
right after ActiveSheet.PrintOut, where as before that never happened and
the file was created.

Here is what I have
-------------------------------------------
Public Function PrintToPDF()

On Error GoTo FuncErr

Dim PSFileName As String
Dim PDFFileName As String
Dim DistillerCall As String
Dim ReturnValue As Variant

Application.StatusBar = "Creating PDF of Calendar"

' Set folder path and file names
Dim DocsFolder As String
DocsFolder = CreateObject("WScript.Shell").SpecialFolders("MyDocuments")
PSFileName = DocsFolder & "\PigeonTrainingCalendar.PS"
PDFFileName = DocsFolder & "\PigeonTrainingCalendar.PDF"

'If the files already exist, delete them:
If Dir(PSFileName) <> "" Then Kill (PSFileName)
If Dir(PDFFileName) <> "" Then Kill (PDFFileName)

'The Sendkeys characters are the full path and filename, followed by the
"Enter" key.
' These are buffered until the "print to file" screen appears:
SendKeys PSFileName & "{ENTER}", False

'Print the document to PDF
ActiveSheet.PrintOut , PrintToFile:=True

' Wait for PDF to finish being created
WaitFileTime PDFFileName, 5

'Add double quotes around the PS filename and PDF filename:
PSFileName = Chr(34) & PSFileName & Chr(34)
PDFFileName = Chr(34) & PDFFileName & Chr(34)
DistillerCall = "C:\Program Files\Adobe\Acrobat 8\Acrobat\Acrodist.exe" & _
" /n /q /o" & PDFFileName & " " & PSFileName

'Call the Acrobat Distiller to distill the PS file. ReturnValue is zero
'if the application doesn't open correctly:
ReturnValue = Shell(DistillerCall, vbNormalFocus)
If ReturnValue = 0 Then MsgBox "Creation of " & PDFFileName & "failed."

FuncExit:
Exit Function

FuncErr:
MsgBox "An Error occured during email setup or submission:" & vbCrLf &
Error, vbInformation, "Problem"
Resume FuncExit

End Function

Function WaitFileTime(xMyFileName As String, xSeconds As Integer)

Dim MoreTime

Do Until Dir(xMyFileName) <> ""
DoEvents
Loop

MoreTime = Timer + xSeconds
Do Until Timer > MoreTime
DoEvents
Loop

End Function
------------------------------------------

"Charabeuh" <Please(a)FeedBack.fr> wrote in message
news:eUGlho4MKHA.508(a)TK2MSFTNGP06.phx.gbl...
> Hello,
> You could create a new sub and then call the sub where you want to wait.
>
> '------------------------------------------------------------------------------------
> Sub WaitFileTime(xMyFileName As String, xSeconds As Integer)
> Dim MoreTime
> Do Until Dir(xMyFileName) <> "": DoEvents: Loop
> MoreTime = Timer + xSeconds
> Do Until Timer > MoreTime: DoEvents: Loop
> End Sub
> '------------------------------------------------------------------------------------
>
> then in your code where you want to wait:
>
> '------------------------------------------------------------------------------------
> WaitFileTime MyFileName, 5
> '------------------------------------------------------------------------------------
>
>
>
>
>
> "Ken" <kolson1971(a)earthlink.net> a �crit dans le message de
> news:eg44L43MKHA.1280(a)TK2MSFTNGP04.phx.gbl...
>> Thank you, but how do I implement it within the existing code. I copied
>> and pasted it and changed the MyFileName variable, but it seems like my
>> code stops somewhere in the timer code.
>>
>> "Charabeuh" <Please(a)FeedBack.fr> wrote in message
>> news:eMgplU0MKHA.4064(a)TK2MSFTNGP06.phx.gbl...
>>> Hello,
>>> If you are waiting for the creation of MyFileName
>>> (replace MyFileName with PDFFileName or PSFileName)
>>> since I'm not sure for which file you want to wait.
>>>
>>> '-----------------------------------------------------
>>> Dim MoreTime
>>>
>>> Do Until Dir(MyFileName) <> ""
>>> DoEvents
>>> Loop
>>>
>>> 'Perhaps you will need more time to
>>> 'wait to the end of creation of the file
>>> 'for exemple 5 seconds
>>>
>>> MoreTime = Timer + 5
>>> Do Until Timer > MoreTime
>>> DoEvents
>>> Loop
>>>
>>> '----------------------------------------------------------
>>>
>>>
>>>
>>>
>>>
>>>
>>>
>>> "Ken" <kolson1971(a)earthlink.net> a �crit dans le message de
>>> news:%23C$3BqzMKHA.3412(a)TK2MSFTNGP04.phx.gbl...
>


From: Charabeuh on
Hello,

It looks like the sendkeys instruction doesn't work anymore
with the new code. Let us drop the sendkeys instruction.

Try this:

replace:
'------------------------------------------------------------------------------------------
'The Sendkeys characters are the full path and filename, followed by the
"Enter" key.
' These are buffered until the "print to file" screen appears:
SendKeys PSFileName & "{ENTER}", False

'Print the document to PDF
ActiveSheet.PrintOut , PrintToFile:=True
'------------------------------------------------------------------------------------------

with
'------------------------------------------------------------------------------------------
'Print the document to PDF
ActiveSheet.Pinot Pintoille:=True, PrToFileName:=PSFileName
'------------------------------------------------------------------------------------------



"Ken" <kolson1971(a)earthlink.net> a �crit dans le message de
news:%23c2niP8MKHA.1796(a)TK2MSFTNGP02.phx.gbl...
> Thank you again.
>
> Not sure what is happening as now I'm being prompted for "Output File
> Name", right after ActiveSheet.PrintOut, where as before that never
> happened and the file was created.
>
> Here is what I have
> -------------------------------------------
> Public Function PrintToPDF()
>
> On Error GoTo FuncErr
>
> Dim PSFileName As String
> Dim PDFFileName As String
> Dim DistillerCall As String
> Dim ReturnValue As Variant
>
> Application.StatusBar = "Creating PDF of Calendar"
>
> ' Set folder path and file names
> Dim DocsFolder As String
> DocsFolder = CreateObject("WScript.Shell").SpecialFolders("MyDocuments")
> PSFileName = DocsFolder & "\PigeonTrainingCalendar.PS"
> PDFFileName = DocsFolder & "\PigeonTrainingCalendar.PDF"
>
> 'If the files already exist, delete them:
> If Dir(PSFileName) <> "" Then Kill (PSFileName)
> If Dir(PDFFileName) <> "" Then Kill (PDFFileName)
>
> 'The Sendkeys characters are the full path and filename, followed by the
> "Enter" key.
> ' These are buffered until the "print to file" screen appears:
> SendKeys PSFileName & "{ENTER}", False
>
> 'Print the document to PDF
> ActiveSheet.PrintOut , PrintToFile:=True
>
> ' Wait for PDF to finish being created
> WaitFileTime PDFFileName, 5
>
> 'Add double quotes around the PS filename and PDF filename:
> PSFileName = Chr(34) & PSFileName & Chr(34)
> PDFFileName = Chr(34) & PDFFileName & Chr(34)
> DistillerCall = "C:\Program Files\Adobe\Acrobat 8\Acrobat\Acrodist.exe" &
> _
> " /n /q /o" & PDFFileName & " " & PSFileName
>
> 'Call the Acrobat Distiller to distill the PS file. ReturnValue is zero
> 'if the application doesn't open correctly:
> ReturnValue = Shell(DistillerCall, vbNormalFocus)
> If ReturnValue = 0 Then MsgBox "Creation of " & PDFFileName & "failed."
>
> FuncExit:
> Exit Function
>
> FuncErr:
> MsgBox "An Error occured during email setup or submission:" & vbCrLf &
> Error, vbInformation, "Problem"
> Resume FuncExit
>
> End Function
>
> Function WaitFileTime(xMyFileName As String, xSeconds As Integer)
>
> Dim MoreTime
>
> Do Until Dir(xMyFileName) <> ""
> DoEvents
> Loop
>
> MoreTime = Timer + xSeconds
> Do Until Timer > MoreTime
> DoEvents
> Loop
>
> End Function
> ------------------------------------------
>
> "Charabeuh" <Please(a)FeedBack.fr> wrote in message
> news:eUGlho4MKHA.508(a)TK2MSFTNGP06.phx.gbl...
>> Hello,
>> You could create a new sub and then call the sub where you want to wait.
>>
>> '------------------------------------------------------------------------------------
>> Sub WaitFileTime(xMyFileName As String, xSeconds As Integer)
>> Dim MoreTime
>> Do Until Dir(xMyFileName) <> "": DoEvents: Loop
>> MoreTime = Timer + xSeconds
>> Do Until Timer > MoreTime: DoEvents: Loop
>> End Sub
>> '------------------------------------------------------------------------------------
>>
>> then in your code where you want to wait:
>>
>> '------------------------------------------------------------------------------------
>> WaitFileTime MyFileName, 5
>> '------------------------------------------------------------------------------------
>>
>>
>>
>>
>>
>> "Ken" <kolson1971(a)earthlink.net> a �crit dans le message de
>> news:eg44L43MKHA.1280(a)TK2MSFTNGP04.phx.gbl...
>>> Thank you, but how do I implement it within the existing code. I copied
>>> and pasted it and changed the MyFileName variable, but it seems like my
>>> code stops somewhere in the timer code.
>>>
>>> "Charabeuh" <Please(a)FeedBack.fr> wrote in message
>>> news:eMgplU0MKHA.4064(a)TK2MSFTNGP06.phx.gbl...
>>>> Hello,
>>>> If you are waiting for the creation of MyFileName
>>>> (replace MyFileName with PDFFileName or PSFileName)
>>>> since I'm not sure for which file you want to wait.
>>>>
>>>> '-----------------------------------------------------
>>>> Dim MoreTime
>>>>
>>>> Do Until Dir(MyFileName) <> ""
>>>> DoEvents
>>>> Loop
>>>>
>>>> 'Perhaps you will need more time to
>>>> 'wait to the end of creation of the file
>>>> 'for exemple 5 seconds
>>>>
>>>> MoreTime = Timer + 5
>>>> Do Until Timer > MoreTime
>>>> DoEvents
>>>> Loop
>>>>
>>>> '----------------------------------------------------------
>>>>
>>>>
>>>>
>>>>
>>>>
>>>>
>>>>
>>>> "Ken" <kolson1971(a)earthlink.net> a �crit dans le message de
>>>> news:%23C$3BqzMKHA.3412(a)TK2MSFTNGP04.phx.gbl...
>>
>
>

From: Charabeuh on
Just an error of automatic correction in my french excel !

instead of reading
ActiveSheet.Pinot Pintoille:=True, PrToFileName:=PSFileName

one should read :
ActiveSheet.PrintOut PrintToFile:=True, PrToFileName:=PSFileName

sorry,


"Charabeuh" <Please(a)FeedBack.fr> a �crit dans le message de
news:uRQd8w8MKHA.1232(a)TK2MSFTNGP05.phx.gbl...
> Hello,
>
> It looks like the sendkeys instruction doesn't work anymore
> with the new code. Let us drop the sendkeys instruction.
>
> Try this:
>
> replace:
> '------------------------------------------------------------------------------------------
> 'The Sendkeys characters are the full path and filename, followed by the
> "Enter" key.
> ' These are buffered until the "print to file" screen appears:
> SendKeys PSFileName & "{ENTER}", False
>
> 'Print the document to PDF
> ActiveSheet.PrintOut , PrintToFile:=True
> '------------------------------------------------------------------------------------------
>
> with
> '------------------------------------------------------------------------------------------
> 'Print the document to PDF
> ActiveSheet.Pinot Pintoille:=True, PrToFileName:=PSFileName
> '------------------------------------------------------------------------------------------
>
>
>
> "Ken" <kolson1971(a)earthlink.net> a �crit dans le message de
> news:%23c2niP8MKHA.1796(a)TK2MSFTNGP02.phx.gbl...
>> Thank you again.
>>
>> Not sure what is happening as now I'm being prompted for "Output File
>> Name", right after ActiveSheet.PrintOut, where as before that never
>> happened and the file was created.
>>
>> Here is what I have
>> -------------------------------------------
>> Public Function PrintToPDF()
>>
>> On Error GoTo FuncErr
>>
>> Dim PSFileName As String
>> Dim PDFFileName As String
>> Dim DistillerCall As String
>> Dim ReturnValue As Variant
>>
>> Application.StatusBar = "Creating PDF of Calendar"
>>
>> ' Set folder path and file names
>> Dim DocsFolder As String
>> DocsFolder = CreateObject("WScript.Shell").SpecialFolders("MyDocuments")
>> PSFileName = DocsFolder & "\PigeonTrainingCalendar.PS"
>> PDFFileName = DocsFolder & "\PigeonTrainingCalendar.PDF"
>>
>> 'If the files already exist, delete them:
>> If Dir(PSFileName) <> "" Then Kill (PSFileName)
>> If Dir(PDFFileName) <> "" Then Kill (PDFFileName)
>>
>> 'The Sendkeys characters are the full path and filename, followed by the
>> "Enter" key.
>> ' These are buffered until the "print to file" screen appears:
>> SendKeys PSFileName & "{ENTER}", False
>>
>> 'Print the document to PDF
>> ActiveSheet.PrintOut , PrintToFile:=True
>>
>> ' Wait for PDF to finish being created
>> WaitFileTime PDFFileName, 5
>>
>> 'Add double quotes around the PS filename and PDF filename:
>> PSFileName = Chr(34) & PSFileName & Chr(34)
>> PDFFileName = Chr(34) & PDFFileName & Chr(34)
>> DistillerCall = "C:\Program Files\Adobe\Acrobat 8\Acrobat\Acrodist.exe" &
>> _
>> " /n /q /o" & PDFFileName & " " & PSFileName
>>
>> 'Call the Acrobat Distiller to distill the PS file. ReturnValue is zero
>> 'if the application doesn't open correctly:
>> ReturnValue = Shell(DistillerCall, vbNormalFocus)
>> If ReturnValue = 0 Then MsgBox "Creation of " & PDFFileName & "failed."
>>
>> FuncExit:
>> Exit Function
>>
>> FuncErr:
>> MsgBox "An Error occured during email setup or submission:" & vbCrLf &
>> Error, vbInformation, "Problem"
>> Resume FuncExit
>>
>> End Function
>>
>> Function WaitFileTime(xMyFileName As String, xSeconds As Integer)
>>
>> Dim MoreTime
>>
>> Do Until Dir(xMyFileName) <> ""
>> DoEvents
>> Loop
>>
>> MoreTime = Timer + xSeconds
>> Do Until Timer > MoreTime
>> DoEvents
>> Loop
>>
>> End Function
>> ------------------------------------------
>>
>> "Charabeuh" <Please(a)FeedBack.fr> wrote in message
>> news:eUGlho4MKHA.508(a)TK2MSFTNGP06.phx.gbl...
>>> Hello,
>>> You could create a new sub and then call the sub where you want to wait.
>>>
>>> '------------------------------------------------------------------------------------
>>> Sub WaitFileTime(xMyFileName As String, xSeconds As Integer)
>>> Dim MoreTime
>>> Do Until Dir(xMyFileName) <> "": DoEvents: Loop
>>> MoreTime = Timer + xSeconds
>>> Do Until Timer > MoreTime: DoEvents: Loop
>>> End Sub
>>> '------------------------------------------------------------------------------------
>>>
>>> then in your code where you want to wait:
>>>
>>> '------------------------------------------------------------------------------------
>>> WaitFileTime MyFileName, 5
>>> '------------------------------------------------------------------------------------
>>>
>>>
>>>
>>>
>>>
>>> "Ken" <kolson1971(a)earthlink.net> a �crit dans le message de
>>> news:eg44L43MKHA.1280(a)TK2MSFTNGP04.phx.gbl...
>>>> Thank you, but how do I implement it within the existing code. I copied
>>>> and pasted it and changed the MyFileName variable, but it seems like my
>>>> code stops somewhere in the timer code.
>>>>
>>>> "Charabeuh" <Please(a)FeedBack.fr> wrote in message
>>>> news:eMgplU0MKHA.4064(a)TK2MSFTNGP06.phx.gbl...
>>>>> Hello,
>>>>> If you are waiting for the creation of MyFileName
>>>>> (replace MyFileName with PDFFileName or PSFileName)
>>>>> since I'm not sure for which file you want to wait.
>>>>>
>>>>> '-----------------------------------------------------
>>>>> Dim MoreTime
>>>>>
>>>>> Do Until Dir(MyFileName) <> ""
>>>>> DoEvents
>>>>> Loop
>>>>>
>>>>> 'Perhaps you will need more time to
>>>>> 'wait to the end of creation of the file
>>>>> 'for exemple 5 seconds
>>>>>
>>>>> MoreTime = Timer + 5
>>>>> Do Until Timer > MoreTime
>>>>> DoEvents
>>>>> Loop
>>>>>
>>>>> '----------------------------------------------------------
>>>>>
>>>>>
>>>>>
>>>>>
>>>>>
>>>>>
>>>>>
>>>>> "Ken" <kolson1971(a)earthlink.net> a �crit dans le message de
>>>>> news:%23C$3BqzMKHA.3412(a)TK2MSFTNGP04.phx.gbl...
>>>
>>
>>
>

From: Ken on
When I step through it (F8) I see that the code gets stuck in the first
DoUntil Loop and never gets to MoreTime Loop.

Are we setting the timer for seconds or minutes?

What is "Timer" as I don't see it declared anywhere? Could that be part of
the problem.


"Charabeuh" <Please(a)FeedBack.fr> wrote in message
news:uY9F338MKHA.1280(a)TK2MSFTNGP04.phx.gbl...
> Just an error of automatic correction in my french excel !
>
> instead of reading
> ActiveSheet.Pinot Pintoille:=True, PrToFileName:=PSFileName
>
> one should read :
> ActiveSheet.PrintOut PrintToFile:=True, PrToFileName:=PSFileName
>
> sorry,
>
>
> "Charabeuh" <Please(a)FeedBack.fr> a �crit dans le message de
> news:uRQd8w8MKHA.1232(a)TK2MSFTNGP05.phx.gbl...
>> Hello,
>>
>> It looks like the sendkeys instruction doesn't work anymore
>> with the new code. Let us drop the sendkeys instruction.
>>
>> Try this:
>>
>> replace:
>> '------------------------------------------------------------------------------------------
>> 'The Sendkeys characters are the full path and filename, followed by the
>> "Enter" key.
>> ' These are buffered until the "print to file" screen appears:
>> SendKeys PSFileName & "{ENTER}", False
>>
>> 'Print the document to PDF
>> ActiveSheet.PrintOut , PrintToFile:=True
>> '------------------------------------------------------------------------------------------
>>
>> with
>> '------------------------------------------------------------------------------------------
>> 'Print the document to PDF
>> ActiveSheet.Pinot Pintoille:=True, PrToFileName:=PSFileName
>> '------------------------------------------------------------------------------------------
>>
>>
>>
>> "Ken" <kolson1971(a)earthlink.net> a �crit dans le message de
>> news:%23c2niP8MKHA.1796(a)TK2MSFTNGP02.phx.gbl...
>>> Thank you again.
>>>
>>> Not sure what is happening as now I'm being prompted for "Output File
>>> Name", right after ActiveSheet.PrintOut, where as before that never
>>> happened and the file was created.
>>>
>>> Here is what I have
>>> -------------------------------------------
>>> Public Function PrintToPDF()
>>>
>>> On Error GoTo FuncErr
>>>
>>> Dim PSFileName As String
>>> Dim PDFFileName As String
>>> Dim DistillerCall As String
>>> Dim ReturnValue As Variant
>>>
>>> Application.StatusBar = "Creating PDF of Calendar"
>>>
>>> ' Set folder path and file names
>>> Dim DocsFolder As String
>>> DocsFolder = CreateObject("WScript.Shell").SpecialFolders("MyDocuments")
>>> PSFileName = DocsFolder & "\PigeonTrainingCalendar.PS"
>>> PDFFileName = DocsFolder & "\PigeonTrainingCalendar.PDF"
>>>
>>> 'If the files already exist, delete them:
>>> If Dir(PSFileName) <> "" Then Kill (PSFileName)
>>> If Dir(PDFFileName) <> "" Then Kill (PDFFileName)
>>>
>>> 'The Sendkeys characters are the full path and filename, followed by the
>>> "Enter" key.
>>> ' These are buffered until the "print to file" screen appears:
>>> SendKeys PSFileName & "{ENTER}", False
>>>
>>> 'Print the document to PDF
>>> ActiveSheet.PrintOut , PrintToFile:=True
>>>
>>> ' Wait for PDF to finish being created
>>> WaitFileTime PDFFileName, 5
>>>
>>> 'Add double quotes around the PS filename and PDF filename:
>>> PSFileName = Chr(34) & PSFileName & Chr(34)
>>> PDFFileName = Chr(34) & PDFFileName & Chr(34)
>>> DistillerCall = "C:\Program Files\Adobe\Acrobat 8\Acrobat\Acrodist.exe"
>>> & _
>>> " /n /q /o" & PDFFileName & " " & PSFileName
>>>
>>> 'Call the Acrobat Distiller to distill the PS file. ReturnValue is zero
>>> 'if the application doesn't open correctly:
>>> ReturnValue = Shell(DistillerCall, vbNormalFocus)
>>> If ReturnValue = 0 Then MsgBox "Creation of " & PDFFileName & "failed."
>>>
>>> FuncExit:
>>> Exit Function
>>>
>>> FuncErr:
>>> MsgBox "An Error occured during email setup or submission:" & vbCrLf
>>> & Error, vbInformation, "Problem"
>>> Resume FuncExit
>>>
>>> End Function
>>>
>>> Function WaitFileTime(xMyFileName As String, xSeconds As Integer)
>>>
>>> Dim MoreTime
>>>
>>> Do Until Dir(xMyFileName) <> ""
>>> DoEvents
>>> Loop
>>>
>>> MoreTime = Timer + xSeconds
>>> Do Until Timer > MoreTime
>>> DoEvents
>>> Loop
>>>
>>> End Function
>>> ------------------------------------------
>>>
>>> "Charabeuh" <Please(a)FeedBack.fr> wrote in message
>>> news:eUGlho4MKHA.508(a)TK2MSFTNGP06.phx.gbl...
>>>> Hello,
>>>> You could create a new sub and then call the sub where you want to
>>>> wait.
>>>>
>>>> '------------------------------------------------------------------------------------
>>>> Sub WaitFileTime(xMyFileName As String, xSeconds As Integer)
>>>> Dim MoreTime
>>>> Do Until Dir(xMyFileName) <> "": DoEvents: Loop
>>>> MoreTime = Timer + xSeconds
>>>> Do Until Timer > MoreTime: DoEvents: Loop
>>>> End Sub
>>>> '------------------------------------------------------------------------------------
>>>>
>>>> then in your code where you want to wait:
>>>>
>>>> '------------------------------------------------------------------------------------
>>>> WaitFileTime MyFileName, 5
>>>> '------------------------------------------------------------------------------------
>>>>
>>>>
>>>>
>>>>
>>>>
>>>> "Ken" <kolson1971(a)earthlink.net> a �crit dans le message de
>>>> news:eg44L43MKHA.1280(a)TK2MSFTNGP04.phx.gbl...
>>>>> Thank you, but how do I implement it within the existing code. I
>>>>> copied and pasted it and changed the MyFileName variable, but it seems
>>>>> like my code stops somewhere in the timer code.
>>>>>
>>>>> "Charabeuh" <Please(a)FeedBack.fr> wrote in message
>>>>> news:eMgplU0MKHA.4064(a)TK2MSFTNGP06.phx.gbl...
>>>>>> Hello,
>>>>>> If you are waiting for the creation of MyFileName
>>>>>> (replace MyFileName with PDFFileName or PSFileName)
>>>>>> since I'm not sure for which file you want to wait.
>>>>>>
>>>>>> '-----------------------------------------------------
>>>>>> Dim MoreTime
>>>>>>
>>>>>> Do Until Dir(MyFileName) <> ""
>>>>>> DoEvents
>>>>>> Loop
>>>>>>
>>>>>> 'Perhaps you will need more time to
>>>>>> 'wait to the end of creation of the file
>>>>>> 'for exemple 5 seconds
>>>>>>
>>>>>> MoreTime = Timer + 5
>>>>>> Do Until Timer > MoreTime
>>>>>> DoEvents
>>>>>> Loop
>>>>>>
>>>>>> '----------------------------------------------------------
>>>>>>
>>>>>>
>>>>>>
>>>>>>
>>>>>>
>>>>>>
>>>>>>
>>>>>> "Ken" <kolson1971(a)earthlink.net> a �crit dans le message de
>>>>>> news:%23C$3BqzMKHA.3412(a)TK2MSFTNGP04.phx.gbl...
>>>>
>>>
>>>
>>
>


From: Chip Pearson on
I have module named modWait.bas that has some functions that you may
find useful. You can download a zip file containing this module from
http://www.cpearson.com/Zips/modWait.zip . Unzip the file to some
folder, open VBA, go to the File menu, choose Import File, navigate to
the folder in which you unzipped the file, and choose modWait.bas.
This will create a new module in your project named modWait.

The functions you might want to try are:

---------------------------
WaitForFileCreate
---------------------------
This waits for a specified file to be created. The declaration is:

Public Function WaitForFileCreate(WaitFileName As String, _
TimeOutSeconds As Long, _
Optional BreakKey As BreakKeyHandler = BreakKeyHandler.Ignore, _
Optional SleepMilliseconds As Long = 500) As FileWaitStatus

where WaitFileName is the name of the file to wait upon,
TimeOutSeconds is the number of seconds to wait before abandoning the
wait. For an infinite wait, set TimeOutSeconds to 0. BreakKey
indicates how the function should respond if the user hits CTRL BREAK.
You can set it to ignore the break key, terminate the wait, or prompt
the user whether to continue the wait. SleepMilliseconds is the
number of milliseconds to pause before retesting the file. If the file
already exists, it returns immediately with a result of Success.

The function returns:

Public Enum FileWaitStatus
Success = -1
UserBreak = 1
FileNotFound
WaitTimeout
End Enum

Success = the wait was successful and the file was created.
UserBreak = the user hit CTRL BREAK to break out of the wait.
WaitTimeout = the TimeOutSeconds period expired before the file was
created.

---------------------------
WaitForFileClose
---------------------------
This waits for a specified file to be closed. The declaration is

Public Function WaitForFileClose(WaitFileName As String, _
TimeOutSeconds As Long, _
Optional BreakKey As BreakKeyHandler = BreakKeyHandler.Ignore, _
Optional SleepMilliseconds As Long = 500) As FileWaitStatus

The parameters have the same meaning in this procedure as they do in
WaitForFileCreate. If the file does not exist, the function returns
immediately with a result of FileNotFound. If the file is not open,
the function return immediately with a result of Success.

The function returns

Public Enum FileWaitStatus
Success = -1
UserBreak = 1
FileNotFound
WaitTimeout
End Enum

Success = the file was closed successfully or was not open.
UserBreak = the user hit CTRL BREAK to break out of the wait.
FileNotFound = the file was not found.
WaitTimeout = the TimeOutSeconds period expired before the file was
closed.

---------------------------
ShellAndWait
---------------------------
This calls Shell to execute a program or command line and waits for
the Shell'd program to finish. The declaration is:

Public Function ShellAndWait(ShellCommand As String, _
TimeOutMs As Long, _
ShellWindowState As VbAppWinStyle, _
BreakKey As ActionOnBreak) As ShellAndWaitResult

where ShellCommand is the command to be passed to Shell, TimeOutMs is
the number of milliseconds to wait before abandoning the wait,
ShellWindowState is the window state to pass to the Shell function,
and BreakKey indicates how to handle the Break key.

The function returns

Public Enum ShellAndWaitResult
Success = 0
Failure
TimeOut
InvalidParameter
SysWaitAbandoned
UserWaitAbandoned
UserBreak
End Enum

Success = The shell'd program ended normally.
Failure = A system error occurred
TimeOut = The timeout period expired before the program finished.
InvalidParameter = The command passed to Shell was invalid.
SysWaitAbandoned = The system abandoned the wait.
UserWaitAbandoned = The user abandoned the wait.
UserBreak = The user pressed CTRL ESC to break out of the wait.

See also http://www.cpearson.com/excel/ShellAndWait.aspx .

In addition to these functions, you might also want to take a look at
Excel's OnTime method and at using Windows system timers. See
http://www.cpearson.com/excel/OnTime.aspx for a discussion and
examples of OnTime and the Windows Timer API functions.



Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)


On Fri, 11 Sep 2009 16:49:27 -0700, "Ken" <kolson1971(a)earthlink.net``>
wrote:

>I'm getting a File Doesn't Exist error when I try to Call this function from
>within my Email function. Sometimes I'm sure it is a timing issue where the
>email is trying to attach this file before it is finished being created.
>
>Would some one be kind enough to supply me with some timer code that tests
>and waits for the file to be created before continuing?
>
>Thanks,
>Ken
>
>**************************************
>Public Function PrintToPDF()
>
>Dim PSFileName As String
>Dim PDFFileName As String
>Dim DistillerCall As String
>Dim ReturnValue As Variant
>
>Application.StatusBar = "Creating PDF of Calendar"
>
>' Set folder path and file names
>Dim DocsFolder As String
>DocsFolder = CreateObject("WScript.Shell").SpecialFolders("MyDocuments")
>PSFileName = DocsFolder & "\PigeonTrainingCalendar.PS"
>PDFFileName = DocsFolder & "\PigeonTrainingCalendar.PDF"
>
>'If the files already exist, delete them:
>If Dir(PSFileName) <> "" Then Kill (PSFileName)
>If Dir(PDFFileName) <> "" Then Kill (PDFFileName)
>
>'The Sendkeys characters are the full path and filename, followed by the
>"Enter" key.
>' These are buffered until the "print to file" screen appears:
>SendKeys PSFileName & "{ENTER}", False
>
>'Print the document to PDF
>ActiveSheet.PrintOut , PrintToFile:=True
>
>'NEED TIMER HERE I THINK
>
>'Add double quotes around the PS filename and PDF filename:
>PSFileName = Chr(34) & PSFileName & Chr(34)
>PDFFileName = Chr(34) & PDFFileName & Chr(34)
>DistillerCall = "C:\Program Files\Adobe\Acrobat 8\Acrobat\Acrodist.exe" & _
>" /n /q /o" & PDFFileName & " " & PSFileName
>
>'Call the Acrobat Distiller to distill the PS file. ReturnValue is zero
>'if the application doesn't open correctly:
>ReturnValue = Shell(DistillerCall, vbNormalFocus)
>If ReturnValue = 0 Then MsgBox "Creation of " & PDFFileName & "failed."
>
>End Function
>*************************************
>