VBA/Excel/Access/Word/Windows API/Shell

Материал из VB Эксперт
Перейти к: навигация, поиск

Creates a text files and saves it

   <source lang="vb">

Sub SKeys()

  Dim ReturnValue
  ReturnValue = Shell("NOTEPAD.EXE", vbNormalFocus)
  AppActivate ReturnValue
  Application.SendKeys "Copy Data.xls c:\", True
  Application.SendKeys "~", True
  Application.SendKeys "%FABATCH~", True

End Sub

</source>
   
  


Having Excel dial the phone, one key at a time

   <source lang="vb">

     

Sub CellToDialer()

   Appname = "Dialer"
   AppFile = "Dialer.exe"
   On Error Resume Next
   AppActivate (Appname)
   If Err <> 0 Then
       Err = 0
       TaskID = Shell(AppFile, 1)
       If Err <> 0 Then MsgBox "Can"t start " & AppFile
   End If
   Application.SendKeys "%n" & "123-1234123123-1234123", True
   Application.SendKeys "%d"

End Sub

</source>
   
  


Returning the Task ID of the Started Application

   <source lang="vb">

Sub task()

   Dim myTaskID As Long
   myTaskID = Shell("c:\w.exe")

End Sub

</source>
   
  


SendKeys to another application

   <source lang="vb">

    Sub SKeys()
        Dim dReturnValue As Double
        dReturnValue = Shell("NOTEPAD.EXE", vbNormalFocus)
        AppActivate dReturnValue
        Application.SendKeys "Copy Data.xlsx c:\", True
        Application.SendKeys "~", True
        Application.SendKeys "%FABATCH%S", True
    End Sub
</source>
   
  


Starting Another Application

   <source lang="vb">

Sub RunCharMap()

   On Error Resume Next
   Program = "notepad.exe"
   TaskID = Shell(Program, 1)
   If Err <> 0 Then
       MsgBox "Cannot start " & Program, vbCritical, "Error"
   End If

End Sub

</source>
   
  


Using VBA to Program Open XML Files

   <source lang="vb">

Sub UnzipPackage()

        Dim o As Object
        Dim TargetFile, NewFileName, DestinationFolder, ofile
        TargetFile = ThisWorkbook.Path & "\SalesByPeriod.xlsx"
        NewFileName = TargetFile & ".zip"
        FileCopy TargetFile, NewFileName
        DestinationFolder = "C:\MyUnzipped"
             On Error Resume Next
             MkDir (DestinationFolder)
        Set o = CreateObject("Shell.Application")
            For Each ofile In o.Namespace(NewFileName).items
            o.Namespace(DestinationFolder).CopyHere (ofile)
        Next ofile
        Kill NewFileName
        Set o = Nothing
    End Sub
</source>