VBA/Excel/Access/Word/Windows API/Shell
Содержание
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