Prev: Content Size for WebBrowser ActiveX Control
Next: On some PC's prints to default windows printer rather then Acrobat PDF defined in code
From: Ken on 12 Sep 2009 12:12 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 12 Sep 2009 13:12 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 12 Sep 2009 13:24 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 12 Sep 2009 14:33 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 12 Sep 2009 20:47
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 >************************************* > |