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

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

Creates a text files and saves it

 
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



Having Excel dial the phone, one key at a time

 
      
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



Returning the Task ID of the Started Application

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



SendKeys to another application

 
     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



Starting Another Application

 
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



Using VBA to Program Open XML Files

 
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