VBA中的Shll、API

一、Shell

1、调用程序打开文件

Sub test1()
    Shell "C:WINDOWS
otepad.exe"             '调用记事本  
    'Shell "C:WINDOWS
otepad.exe  C:1.txt"  '用记事本打开C:下的1.txt
End Sub    

2、打开网页

Sub test2()
    '调用浏览器打开一个指定网页：
    Shell "C:Program FilesInternet Exploreriexplore.exe https://www.cnblogs.com/Stefan-Gao/p/14288841.html"
End Sub

 二、API

1、检测是否联网

'检查是否连接Internet
Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" Alias "InternetGetConnectedStateExA" (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, ByVal dwNameLen As Long, ByVal dwReserved As Long) As Long

'检查网络是否连接函数
Public Function InternetConnected(Optional ByRef eConnectionInfo As String, Optional ByRef sConnectionName As String) As Boolean
    Dim dwFlags As Long
    Dim sNameBuf As String
    InternetConnected = InternetGetConnectedStateEx(dwFlags, sNameBuf, 512, 0&)
End Function

Sub 联网检测()
  If InternetConnected Then MsgBox "已联网"
End Sub

2、从网站上下载网页

'下载文件的API
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

'下载文件函数
Function DownLoadFile(Url As String, LocalPath As String) As Long
   DownLoadFile = URLDownloadToFile(0, Url, LocalPath, 0, 0)
End Function
Sub 下载网页到指定文件夹()
  DownLoadFile "https://www.cnblogs.com/Stefan-Gao/p/14288841.html", "E:	emp1.html"
End Sub

3、进度条示例：

在VBA中系统内置的控件很少，如果要调用其他控件，那么这个文档拷贝给别人时，还需要把那个控件对应的DLL一并拷贝给别人，有的还需要用Regsvr32进行注册，非常不方便，所以，在VBA中尽量就地取材。

此进度条示例，用的是一个窗体（进度条），窗体上有一个Frame（Progress）控件，通过循环不断增加Frame的宽度，形成进度条效果。

3.1、窗体属性设置：

KeepScrollBarsVisible=0

PictureSizeMode=0

ShowModal=False

StartUpPosition=2 - 屏幕中心

3.2、窗体中代码

'窗体中代码
#If Win64 Then
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#Else
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#End If

'窗体初始化
Private Sub UserForm_Initialize()
    '将窗体设置为全部按钮都没有，不能改变大小
    SetWindowLong FindWindow(vbNullString, Me.Caption), -16, &H6C10000
End Sub

3.3、模块中调用

Sub 进度条示例()
    Dim 总数&, 进度条总宽度&, i&
    总数 = 1000
    进度条总宽度 = JDT.Progress.Width
    JDT.Progress.Width = 0
    For i = 1 To 总数
        JDT.Progress.Width = 进度条总宽度 * (i / 总数)   '进度条宽度改变
        Cells(i, 1).Value = i                         '事件进度
        JDT.Show                                      '显示窗体
        DoEvents                                      '转移控制权，效果就是让进度条不断刷新
    Next
    Unload JDT                                        '关闭窗体
End Sub