title: How to get delay between letters in PowerPoint application?
body: <p>I want to export animation as mp4 in PowerPoint and get the timeline of all animation.</p>
  <p>How do I get the delay between letters if the effect has <code>EffectInformation.TextUnitEffect as msoAnimTextUnitEffectByCharacter</code>?</p>
  <p>Most documentation for PowerPoint I have read, but no message for &quot;%delay between letters&quot;.</p>
  <p><code>effectinformation</code> documentation has no message as delay between letters in (<a href="https://docs.microsoft.com/en-us/office/vba/api/powerpoint.effectinformation.textuniteffect" rel="nofollow noreferrer">https://docs.microsoft.com/en-us/office/vba/api/powerpoint.effectinformation.textuniteffect</a>)</p>
  <pre><code>CONST ppLayoutBlank = 12 ''ppt new black slide
  CONST ppSaveAsMP4 = 39 ''ppSaveFormat for mp4
  CONST ForAppending = 8 ''log file write for appending
  
  const ppViewSlideMaster = 2 ''viewtype
  const ppViewHandoutMaster = 4
  const ppViewTitleMaster = 8
  const ppViewMasterThumbnails = 12
  
  const msoAnimTextUnitEffectByCharacter = 1
  
  Dim filePath
  dim logFilePath
  dim logFile
  dim fullPath
  
  logFilePath = &quot;.\convert.log&quot;     '''''''logfile
   
  filePath = SelectFile()
  
  if len(filePath)&lt;1 then
      wscript.quit
  end if
  
  MsgBox filePath + &quot;;&quot;
  
  Set ObjFSO = CreateObject(&quot;Scripting.FileSystemObject&quot;)
  Set objPPT = CreateObject(&quot;PowerPoint.Application&quot;)
  
  objPPT.Visible = True
  
  ''create log file
  if ObjFSO.fileExists(logFilePath) then
      set logFile = ObjFSO.OpenTextFile(logFilePath, ForAppending)
  else
      set logFile = ObjFSO.CreateTextFile(logFilePath)
  end if
  
  ''do job
  pptAnimate(filePath)
  
  ''quit or not
  ''objPPT.Quit()
  
  
  Function SelectFile()
      dim selectPath,selectPathLen
      Set wShell=CreateObject(&quot;WScript.Shell&quot;)
      Set oExec=wShell.Exec(&quot;mshta.exe &quot;&quot;about:&lt;input type=file id=FILE&gt;&lt;script&gt;FILE.click();new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);&lt;/script&gt;&quot;&quot;&quot;)
      selectPath = oExec.StdOut.ReadAll
      selectPathLen = len(selectPath)
      SelectFile = left(selectPath, selectPathLen-2)'''''remove \r\n, vbcr、vblf
  End Function
  
  Sub pptAnimate(pptPath)
  
      if not (regMatch(pptPath, &quot;\.(ppt|pptx)$&quot;)) then
          exit sub
      end if
      
      Set pptInput = objPPT.Presentations.Open(pptPath)
      
      logFile.WriteLine(&quot;slide count:&quot; + cstr(pptInput.Slides.Count))
      For i = 1 To pptInput.Slides.Count
          if pptInput.Slides(i).TimeLine.MainSequence.Count &gt; 0 then
          
              Dim tmpPath
              tmpPath = &quot;F:\\word\\&quot; + cstr(i) + &quot;.pptx&quot;
              ObjFSO.CreateTextFile(tmpPath)
              Set pptOutput = objPPT.Presentations.Open(tmpPath)
              Set newSlide = pptOutput.Slides.Add(1, ppLayoutBlank)
              
              pptOutput.PageSetup.slideWidth = pptInput.PageSetup.slideWidth
              pptOutput.pageSetup.slideHeight = pptInput.pagesetup.slideheight
              
              pptInput.Slides(i).Copy
              pptOutput.Slides.Paste (pptOutput.Slides.Count)
                      
              logFile.WriteLine(&quot;page:&quot; + cstr(i) + &quot; sequence count:&quot; + cstr(pptInput.Slides(i).TimeLine.MainSequence.Count))
              For Each effect in pptInput.Slides(i).TimeLine.MainSequence
              
                  logFile.WriteLine(&quot;{delay time:&quot; + cstr(effect.Timing.TriggerDelayTime) _
                  + &quot;, duration time:&quot; + cstr(effect.Timing.Duration) _
                  + &quot;, Decelerate :&quot; + cstr(effect.Timing.Decelerate) _
                  + &quot;, triggerType:&quot; + getTriggerType(effect.Timing.TriggerType) _
                  + &quot;, Accelerate:&quot; + cstr(effect.Timing.Accelerate) _
                  + &quot;, Decelerate:&quot; + cstr(effect.Timing.Decelerate) _
                  + &quot;, Speed:&quot; + cstr(effect.Timing.Speed) _
                  + &quot;}&quot;)
                  
                  if msoAnimTextUnitEffectByCharacter = effect.EffectInformation.TextUnitEffect then
                      ''I don't know how to get dealy between letters, have no way to set the effect to by graph
                      ''effect.EffectInformation.TextUnitEffect = 0 '''readonly
                  end if
                  
                  For Each behaviour in effect.Behaviors
                      logFile.WriteLine(&quot;behaviour {delay time :&quot; + cstr(behaviour.Timing.TriggerDelayTime) + &quot;, duration time :&quot; + cstr(behaviour.Timing.Duration) +  &quot;}&quot;)
                  Next
              Next
                          
              m = pptOutput.Slides.Count
              pptOutput.Slides(m).Delete
              
              ''fullPath = &quot;F:\\word\\&quot;+cstr(i)+&quot;.mp4&quot;
              ''pptOutput.SaveAs fullPath,ppSaveAsMP4
              '''wait until the mp4 file exist,
              '''msgbox fullPath
              pptOutput.Save
              pptOutput.Close
          end if
      Next    
      
      pptInput.Close
  End Sub
  
  Function regMatch(strng,Pattern)  
      Dim regEx  
      Set regEx = New RegExp  
      regEx.Pattern = Pattern  
      regEx.IgnoreCase = True  
      regEx.Global = True  
      regMatch = regEx.test(strng)  
      Set regEx = Nothing  
  End Function 
  
  'https://docs.microsoft.com/zh-cn/office/vba/api/powerpoint.msoanimtriggertype
  Function getTriggerType(triggerType)
      getTriggerType = &quot;&quot;
      Select Case triggerType
          Case 3
              getTriggerType = &quot;msoAnimTriggerAfterPrevious&quot;
          Case -1
              getTriggerType = &quot;msoAnimTriggerMixed&quot;
          Case 0
              getTriggerType = &quot;msoAnimTriggerNone&quot;
          Case 1
              getTriggerType = &quot;msoAnimTriggerOnPageClick&quot;
          Case 4
              getTriggerType = &quot;msoAnimTriggerOnShapeClick&quot;
          Case 2
              getTriggerType = &quot;msoAnimTriggerWithPrevious&quot;
      End Select
      
  End Function
  
  Function Format_Time(s_Time, n_Flag)
      Dim y, m, d, h, mi, s
      Format_Time = &quot;&quot;
      If IsDate(s_Time) = False Then Exit Function
      y = cstr(year(s_Time))
      m = cstr(month(s_Time))
      If len(m) = 1 Then m = &quot;0&quot; &amp; m
      d = cstr(day(s_Time))
      If len(d) = 1 Then d = &quot;0&quot; &amp; d
      h = cstr(hour(s_Time))
      If len(h) = 1 Then h = &quot;0&quot; &amp; h
      mi = cstr(minute(s_Time))
      If len(mi) = 1 Then mi = &quot;0&quot; &amp; mi
      s = cstr(second(s_Time))
      If len(s) = 1 Then s = &quot;0&quot; &amp; s
      Select Case n_Flag
          Case 1
              ' yyyy-mm-dd hh:mm:ss
              Format_Time = y &amp; &quot;-&quot; &amp; m &amp; &quot;-&quot; &amp; d  &amp; &quot; &quot;&amp; h  &amp;&quot;:&quot; &amp;  mi  &amp;&quot;:&quot; &amp; s
          Case 2
              ' yyyy-mm-dd
              Format_Time = y &amp; &quot;-&quot; &amp; m &amp; &quot;-&quot; &amp; d
          Case 3
              ' hh:mm:ss
              Format_Time = h &amp; &quot;:&quot; &amp; mi &amp; &quot;:&quot; &amp; s
          Case 4
              ' yyyymmdd
              Format_Time = y &amp; m &amp; d
      End Select
  End Function
  </code></pre>