サーチ…
前書き
APIはApplication Programming Interface
VBA用のAPIは、オペレーティングシステムと直接対話できる一連のメソッドを意味します
システムコールは、DLLファイルで定義されたプロシージャを実行することによって行うことができます。
備考
一般的なオペレーティング環境のライブラリファイル(DLL):
ダイナミックリンクライブラリ | 説明 |
---|---|
Advapi32.dll | 多くのセキュリティとレジストリ呼び出しを含むAPIの高度なサービスライブラリ |
Comdlg32.dll | 共通ダイアログAPIライブラリ |
Gdi32.dll | グラフィックデバイスインタフェースAPIライブラリ |
Kernel32.dll | コアWindows 32ビットベースAPIのサポート |
Lz32.dll | 32ビット圧縮ルーチン |
Mpr.dll | 複数のプロバイダのルータライブラリ |
Netapi32.dll | 32ビットネットワークAPIライブラリ |
Shell32.dll | 32ビットシェルAPIライブラリ |
User32.dll | ユーザーインターフェイスルーチンのライブラリ |
Version.dll | バージョンライブラリ |
Winmm.dll | Windowsマルチメディアライブラリ |
Winspool.drv | 印刷スプーラーAPI呼び出しを含むスプーラーインターフェイスを印刷する |
64システムで使用される新しい引数:
タイプ | 項目 | 説明 |
---|---|---|
修飾子 | PtrSafe | Declareステートメントが64ビットと互換性があることを示します。この属性は、64ビットシステムで必須です |
データ・タイプ | LongPtr | 32ビットバージョンでは4バイトのデータ型、Office 2010の64ビットバージョンでは8バイトのデータ型の可変データ型です。これは新しいコードのポインタまたはハンドルを宣言するための推奨方法ですが、 64ビットバージョンのOffice 2010で実行する必要がある場合はレガシーコード用です.32ビットと64ビットのVBA 7ランタイムでのみサポートされています。数値型は代入できますが、数値型は代入できないことに注意してください |
データ・タイプ | LongLong | これは、64ビットバージョンのOffice 2010でのみ使用できる8バイトのデータ型です。数値型は割り当てできません(切り捨てを避けるため) |
変換 | オペレーター | CLngPtr単純式をLongPtrデータ型に変換します。 |
変換 | オペレーター | CLngLng単純式をLongLongデータ型に変換します。 |
関数 | VarPtr | バリアントコンバータ。 64ビットバージョンでLongPtrを返し、32ビット(4バイト)でLongを返します。 |
関数 | ObjPtr | オブジェクトコンバータ。 64ビットバージョンでLongPtrを返し、32ビット(4バイト)でLongを返します。 |
関数 | StrPtr | 文字列変換器。 64ビットバージョンでLongPtrを返し、32ビット(4バイト)でLongを返します。 |
コールサインの完全な参照:
Visual Basic 5.0用のWin32api32.txt (古いAPI宣言、最後にレビューされた2005年3月、Microsoft)
64ビットサポートのWin32API_PtrSafe (Office 2010、Microsoft)
APIの宣言と使用法
異なるVBAバージョンで動作するようにDLLプロシージャを宣言する :
Option Explicit
#If Win64 Then
Private Declare PtrSafe Sub xLib "Kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
#ElseIf Win32 Then
Private Declare Sub apiSleep Lib "Kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
#End If
上記の宣言は、Kernel32.dllファイルで定義された "Sleep"関数を呼び出す方法をVBAに伝えます
Win64およびWin32は、 条件付きコンパイルに使用されるあらかじめ定義された定数です
あらかじめ定義された定数
いくつかのコンパイル定数は、あらかじめ定義されています。どちらが存在するかは、VBAを実行しているオフィスバージョンのビット数によって異なります.Vba7は、Office 2010と共に64ビットバージョンのOfficeをサポートするために導入されました。
定数 | 16ビット | 32ビット | 64ビット |
---|---|---|---|
Vba6 | 偽 | Vba6 | 偽 |
Vba7 | 偽 | Vba7の場合 | 真 |
Win16 | 真 | 偽 | 偽 |
Win32 | 偽 | 真 | 真 |
Win64 | 偽 | 偽 | 真 |
マック | 偽 | Macの場合 | Macの場合 |
これらの定数は、Windows版ではなくOffice版を指します。たとえば、OSが64ビット版のWindowsであっても、32ビット版OfficeではWin32 = TRUEとなります。
APIを宣言するときの主な違いは、新しいパラメータ型を導入した32ビット版と64ビット版のOfficeバージョン間です(詳細は「備考」を参照)
ノート:
- 宣言は、モジュールの上部に配置され、サブモジュールまたは関数の外側に配置されます
- 標準モジュールで宣言された手続きは、デフォルトでpublicです
- モジュールのプライベート・プロシージャを宣言するには、宣言の前に
Private
キーワードを付けます- 他のタイプのモジュールで宣言されているDLLプロシージャは、そのモジュール専用です
Sleep API呼び出しの簡単な例:
Public Sub TestPause()
Dim start As Double
start = Timer
Sleep 9000 'Pause execution for 9 seconds
Debug.Print "Paused for " & Format(Timer - start, "#,###.000") & " seconds"
'Immediate window result: Paused for 9.000 seconds
End Sub
VBAラッパーからシステムファンクションに簡単にアクセスできるようにする専用のAPIモジュールを作成することをお勧めします。通常のVBA Subs、またはライブラリで使用されるパラメータなどの実際のシステムコールに必要な詳細をカプセル化するファンクション
モジュールには、宣言と依存関係をすべて含めることができます。
- メソッドシグネチャと必要なデータ構造
- 入力の検証を実行し、すべてのパラメータが期待どおりに渡されるようにするラッパー
DLLプロシージャを宣言するには、 Declare
ステートメントをコードウィンドウのDeclarationsセクションに追加します。
プロシージャが値を返す場合は、 関数として宣言します。
Declare Function publicname Lib "libname" [Alias "alias"] [([[ByVal] variable [As type] [,[ByVal] variable [As type]]...])] As Type
プロシージャが値を返さない場合は、 Subとして宣言します。
Declare Sub publicname Lib "libname" [Alias "alias"] [([[ByVal] variable [As type] [,[ByVal] variable [As type]]...])]
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!
また、APIへの無効な呼び出しがExcelをクラッシュさせ 、おそらくデータファイルを破損させることに注意してください
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!
Office 2011 for Mac
Private Declare Function system Lib "libc.dylib" (ByVal command As String) As Long
Sub RunSafari()
Dim result As Long
result = system("open -a Safari --args http://www.google.com")
Debug.Print Str(result)
End Sub
以下の例(Windows API - 専用モジュール(1と2))では、Win64とWin32の一般的な宣言を含むAPIモジュールを示しています
Windows API - 専用モジュール(1 of 2)
Option Explicit
#If Win64 Then 'Win64 = True, Win32 = False, Win16 = False
Private Declare PtrSafe Sub apiCopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (MyDest As Any, MySource As Any, ByVal MySize As Long)
Private Declare PtrSafe Sub apiExitProcess Lib "Kernel32" Alias "ExitProcess" (ByVal uExitCode As Long)
Private Declare PtrSafe Sub apiSetCursorPos Lib "User32" Alias "SetCursorPos" (ByVal X As Integer, ByVal Y As Integer)
Private Declare PtrSafe Sub apiSleep Lib "Kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function apiAttachThreadInput Lib "User32" Alias "AttachThreadInput" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
Private Declare PtrSafe Function apiBringWindowToTop Lib "User32" Alias "BringWindowToTop" (ByVal lngHWnd As Long) As Long
Private Declare PtrSafe Function apiCloseWindow Lib "User32" Alias "CloseWindow" (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function apiDestroyWindow Lib "User32" Alias "DestroyWindow" (ByVal hWnd As Long) As Boolean
Private Declare PtrSafe Function apiEndDialog Lib "User32" Alias "EndDialog" (ByVal hWnd As Long, ByVal result As Long) As Boolean
Private Declare PtrSafe Function apiEnumChildWindows Lib "User32" Alias "EnumChildWindows" (ByVal hWndParent As Long, ByVal pEnumProc As Long, ByVal lParam As Long) As Long
Private Declare PtrSafe Function apiExitWindowsEx Lib "User32" Alias "ExitWindowsEx" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare PtrSafe Function apiFindExecutable Lib "Shell32" Alias "FindExecutableA" (ByVal lpFile As String, ByVallpDirectory As String, ByVal lpResult As String) As Long
Private Declare PtrSafe Function apiFindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function apiFindWindowEx Lib "User32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare PtrSafe Function apiGetActiveWindow Lib "User32" Alias "GetActiveWindow" () As Long
Private Declare PtrSafe Function apiGetClassNameA Lib "User32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal szClassName As String, ByVal lLength As Long) As Long
Private Declare PtrSafe Function apiGetCommandLine Lib "Kernel32" Alias "GetCommandLineW" () As Long
Private Declare PtrSafe Function apiGetCommandLineParams Lib "Kernel32" Alias "GetCommandLineA" () As Long
Private Declare PtrSafe Function apiGetDiskFreeSpaceEx Lib "Kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As Currency, lpTotalNumberOfFreeBytes As Currency) As Long
Private Declare PtrSafe Function apiGetDriveType Lib "Kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare PtrSafe Function apiGetExitCodeProcess Lib "Kernel32" Alias "GetExitCodeProcess" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare PtrSafe Function apiGetForegroundWindow Lib "User32" Alias "GetForegroundWindow" () As Long
Private Declare PtrSafe Function apiGetFrequency Lib "Kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare PtrSafe Function apiGetLastError Lib "Kernel32" Alias "GetLastError" () As Integer
Private Declare PtrSafe Function apiGetParent Lib "User32" Alias "GetParent" (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function apiGetSystemMetrics Lib "User32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
Private Declare PtrSafe Function apiGetSystemMetrics32 Lib "User32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
Private Declare PtrSafe Function apiGetTickCount Lib "Kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
Private Declare PtrSafe Function apiGetTickCountMs Lib "Kernel32" Alias "GetTickCount" () As Long
Private Declare PtrSafe Function apiGetUserName Lib "AdvApi32" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare PtrSafe Function apiGetWindow Lib "User32" Alias "GetWindow" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare PtrSafe Function apiGetWindowRect Lib "User32" Alias "GetWindowRect" (ByVal hWnd As Long, lpRect As winRect) As Long
Private Declare PtrSafe Function apiGetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal szWindowText As String, ByVal lLength As Long) As Long
Private Declare PtrSafe Function apiGetWindowThreadProcessId Lib "User32" Alias "GetWindowThreadProcessId" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare PtrSafe Function apiIsCharAlphaNumericA Lib "User32" Alias "IsCharAlphaNumericA" (ByVal byChar As Byte) As Long
Private Declare PtrSafe Function apiIsIconic Lib "User32" Alias "IsIconic" (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function apiIsWindowVisible Lib "User32" Alias "IsWindowVisible" (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function apiIsZoomed Lib "User32" Alias "IsZoomed" (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function apiLStrCpynA Lib "Kernel32" Alias "lstrcpynA" (ByVal pDestination As String, ByVal pSource As Long, ByVal iMaxLength As Integer) As Long
Private Declare PtrSafe Function apiMessageBox Lib "User32" Alias "MessageBoxA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Declare PtrSafe Function apiOpenIcon Lib "User32" Alias "OpenIcon" (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function apiOpenProcess Lib "Kernel32" Alias "OpenProcess" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare PtrSafe Function apiPathAddBackslashByPointer Lib "ShlwApi" Alias "PathAddBackslashW" (ByVal lpszPath As Long) As Long
Private Declare PtrSafe Function apiPathAddBackslashByString Lib "ShlwApi" Alias "PathAddBackslashW" (ByVal lpszPath As String) As Long 'http://msdn.microsoft.com/en-us/library/aa155716%28office.10%29.aspx
Private Declare PtrSafe Function apiPostMessage Lib "User32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare PtrSafe Function apiRegQueryValue Lib "AdvApi32" Alias "RegQueryValue" (ByVal hKey As Long, ByVal sValueName As String, ByVal dwReserved As Long, ByRef lValueType As Long, ByVal sValue As String, ByRef lResultLen As Long) As Long
Private Declare PtrSafe Function apiSendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare PtrSafe Function apiSetActiveWindow Lib "User32" Alias "SetActiveWindow" (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function apiSetCurrentDirectoryA Lib "Kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
Private Declare PtrSafe Function apiSetFocus Lib "User32" Alias "SetFocus" (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function apiSetForegroundWindow Lib "User32" Alias "SetForegroundWindow" (ByVal hWnd As Long) As Long
Private Declare PtrSafe Function apiSetLocalTime Lib "Kernel32" Alias "SetLocalTime" (lpSystem As SystemTime) As Long
Private Declare PtrSafe Function apiSetWindowPlacement Lib "User32" Alias "SetWindowPlacement" (ByVal hWnd As Long, ByRef lpwndpl As winPlacement) As Long
Private Declare PtrSafe Function apiSetWindowPos Lib "User32" Alias "SetWindowPos" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare PtrSafe Function apiSetWindowText Lib "User32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare PtrSafe Function apiShellExecute Lib "Shell32" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare PtrSafe Function apiShowWindow Lib "User32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare PtrSafe Function apiShowWindowAsync Lib "User32" Alias "ShowWindowAsync" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare PtrSafe Function apiStrCpy Lib "Kernel32" Alias "lstrcpynA" (ByVal pDestination As String, ByVal pSource As String, ByVal iMaxLength As Integer) As Long
Private Declare PtrSafe Function apiStringLen Lib "Kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare PtrSafe Function apiStrTrimW Lib "ShlwApi" Alias "StrTrimW" () As Boolean
Private Declare PtrSafe Function apiTerminateProcess Lib "Kernel32" Alias "TerminateProcess" (ByVal hWnd As Long, ByVal uExitCode As Long) As Long
Private Declare PtrSafe Function apiTimeGetTime Lib "Winmm" Alias "timeGetTime" () As Long
Private Declare PtrSafe Function apiVarPtrArray Lib "MsVbVm50" Alias "VarPtr" (Var() As Any) As Long
Private Type browseInfo 'used by apiBrowseForFolder
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare PtrSafe Function apiBrowseForFolder Lib "Shell32" Alias "SHBrowseForFolderA" (lpBrowseInfo As browseInfo) As Long
Private Type CHOOSECOLOR 'used by apiChooseColor; http://support.microsoft.com/kb/153929 and http://www.cpearson.com/Excel/Colors.aspx
lStructSize As Long
hWndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As String
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Declare PtrSafe Function apiChooseColor Lib "ComDlg32" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
Private Type FindWindowParameters 'Custom structure for passing in the parameters in/out of the hook enumeration function; could use global variables instead, but this is nicer
strTitle As String 'INPUT
hWnd As Long 'OUTPUT
End Type 'Find a specific window with dynamic caption from a list of all open windows: http://www.everythingaccess.com/tutorials.asp?ID=Bring-an-external-application-window-to-the-foreground
Private Declare PtrSafe Function apiEnumWindows Lib "User32" Alias "EnumWindows" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
Private Type lastInputInfo 'used by apiGetLastInputInfo, getLastInputTime
cbSize As Long
dwTime As Long
End Type
Private Declare PtrSafe Function apiGetLastInputInfo Lib "User32" Alias "GetLastInputInfo" (ByRef plii As lastInputInfo) As Long
'http://www.pgacon.com/visualbasic.htm#Take%20Advantage%20of%20Conditional%20Compilation
'Logical and Bitwise Operators in Visual Basic: http://msdn.microsoft.com/en-us/library/wz3k228a(v=vs.80).aspx and http://stackoverflow.com/questions/1070863/hidden-features-of-vba
Private Type SystemTime
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Declare PtrSafe Sub apiGetLocalTime Lib "Kernel32" Alias "GetLocalTime" (lpSystem As SystemTime)
Private Type pointAPI 'used by apiSetWindowPlacement
X As Long
Y As Long
End Type
Private Type rectAPI 'used by apiSetWindowPlacement
Left_Renamed As Long
Top_Renamed As Long
Right_Renamed As Long
Bottom_Renamed As Long
End Type
Private Type winPlacement 'used by apiSetWindowPlacement
length As Long
flags As Long
showCmd As Long
ptMinPosition As pointAPI
ptMaxPosition As pointAPI
rcNormalPosition As rectAPI
End Type
Private Declare PtrSafe Function apiGetWindowPlacement Lib "User32" Alias "GetWindowPlacement" (ByVal hWnd As Long, ByRef lpwndpl As winPlacement) As Long
Private Type winRect 'used by apiMoveWindow
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare PtrSafe Function apiMoveWindow Lib "User32" Alias "MoveWindow" (ByVal hWnd As Long, xLeft As Long, ByVal yTop As Long, wWidth As Long, ByVal hHeight As Long, ByVal repaint As Long) As Long
Private Declare PtrSafe Function apiInternetOpen Lib "WiniNet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long 'Open the Internet object 'ex: lngINet = InternetOpen(“MyFTP Control”, 1, vbNullString, vbNullString, 0)
Private Declare PtrSafe Function apiInternetConnect Lib "WiniNet" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long 'Connect to the network 'ex: lngINetConn = InternetConnect(lngINet, "ftp.microsoft.com", 0, "anonymous", "[email protected]", 1, 0, 0)
Private Declare PtrSafe Function apiFtpGetFile Lib "WiniNet" Alias "FtpGetFileA" (ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean 'Get a file 'ex: blnRC = FtpGetFile(lngINetConn, "dirmap.txt", "c:\dirmap.txt", 0, 0, 1, 0)
Private Declare PtrSafe Function apiFtpPutFile Lib "WiniNet" Alias "FtpPutFileA" (ByVal hFtpSession As Long, ByVal lpszLocalFile As String, ByVal lpszRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean 'Send a file 'ex: blnRC = FtpPutFile(lngINetConn, “c:\dirmap.txt”, “dirmap.txt”, 1, 0)
Private Declare PtrSafe Function apiFtpDeleteFile Lib "WiniNet" Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean 'Delete a file 'ex: blnRC = FtpDeleteFile(lngINetConn, “test.txt”)
Private Declare PtrSafe Function apiInternetCloseHandle Lib "WiniNet" (ByVal hInet As Long) As Integer 'Close the Internet object 'ex: InternetCloseHandle lngINetConn 'ex: InternetCloseHandle lngINet
Private Declare PtrSafe Function apiFtpFindFirstFile Lib "WiniNet" Alias "FtpFindFirstFileA" (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 1 'MAX_FTP_PATH
cAlternate As String * 14
End Type 'ex: lngHINet = FtpFindFirstFile(lngINetConn, "*.*", pData, 0, 0)
Private Declare PtrSafe Function apiInternetFindNextFile Lib "WiniNet" Alias "InternetFindNextFileA" (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long 'ex: blnRC = InternetFindNextFile(lngHINet, pData)
#ElseIf Win32 Then 'Win32 = True, Win16 = False
(第2の例に続く)
Windows API - 専用モジュール(2/2)
#ElseIf Win32 Then 'Win32 = True, Win16 = False
Private Declare Sub apiCopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (MyDest As Any, MySource As Any, ByVal MySize As Long)
Private Declare Sub apiExitProcess Lib "Kernel32" Alias "ExitProcess" (ByVal uExitCode As Long)
'Private Declare Sub apiGetStartupInfo Lib "Kernel32" Alias "GetStartupInfoA" (lpStartupInfo As STARTUPINFO)
Private Declare Sub apiSetCursorPos Lib "User32" Alias "SetCursorPos" (ByVal X As Integer, ByVal Y As Integer) 'Logical and Bitwise Operators in Visual Basic: http://msdn.microsoft.com/en-us/library/wz3k228a(v=vs.80).aspx and http://stackoverflow.com/questions/1070863/hidden-features-of-vba 'http://www.pgacon.com/visualbasic.htm#Take%20Advantage%20of%20Conditional%20Compilation
Private Declare Sub apiSleep Lib "Kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
Private Declare Function apiAttachThreadInput Lib "User32" Alias "AttachThreadInput" (ByVal idAttach As Long, ByVal idAttachTo As Long, ByVal fAttach As Long) As Long
Private Declare Function apiBringWindowToTop Lib "User32" Alias "BringWindowToTop" (ByVal lngHWnd As Long) As Long
Private Declare Function apiCloseHandle Lib "Kernel32" (ByVal hObject As Long) As Long
Private Declare Function apiCloseWindow Lib "User32" Alias "CloseWindow" (ByVal hWnd As Long) As Long
'Private Declare Function apiCreatePipe Lib "Kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
'Private Declare Function apiCreateProcess Lib "Kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function apiDestroyWindow Lib "User32" Alias "DestroyWindow" (ByVal hWnd As Long) As Boolean
Private Declare Function apiEndDialog Lib "User32" Alias "EndDialog" (ByVal hWnd As Long, ByVal result As Long) As Boolean
Private Declare Function apiEnumChildWindows Lib "User32" Alias "EnumChildWindows" (ByVal hWndParent As Long, ByVal pEnumProc As Long, ByVal lParam As Long) As Long
Private Declare Function apiExitWindowsEx Lib "User32" Alias "ExitWindowsEx" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function apiFindExecutable Lib "Shell32" Alias "FindExecutableA" (ByVal lpFile As String, ByVallpDirectory As String, ByVal lpResult As String) As Long
Private Declare Function apiFindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function apiFindWindowEx Lib "User32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function apiGetActiveWindow Lib "User32" Alias "GetActiveWindow" () As Long
Private Declare Function apiGetClassNameA Lib "User32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal szClassName As String, ByVal lLength As Long) As Long
Private Declare Function apiGetCommandLine Lib "Kernel32" Alias "GetCommandLineW" () As Long
Private Declare Function apiGetCommandLineParams Lib "Kernel32" Alias "GetCommandLineA" () As Long
Private Declare Function apiGetDiskFreeSpaceEx Lib "Kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As Currency, lpTotalNumberOfFreeBytes As Currency) As Long
Private Declare Function apiGetDriveType Lib "Kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function apiGetExitCodeProcess Lib "Kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function apiGetFileSize Lib "Kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function apiGetForegroundWindow Lib "User32" Alias "GetForegroundWindow" () As Long
Private Declare Function apiGetFrequency Lib "Kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function apiGetLastError Lib "Kernel32" Alias "GetLastError" () As Integer
Private Declare Function apiGetParent Lib "User32" Alias "GetParent" (ByVal hWnd As Long) As Long
Private Declare Function apiGetSystemMetrics Lib "User32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
Private Declare Function apiGetTickCount Lib "Kernel32" Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
Private Declare Function apiGetTickCountMs Lib "Kernel32" Alias "GetTickCount" () As Long
Private Declare Function apiGetUserName Lib "AdvApi32" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function apiGetWindow Lib "User32" Alias "GetWindow" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function apiGetWindowRect Lib "User32" Alias "GetWindowRect" (ByVal hWnd As Long, lpRect As winRect) As Long
Private Declare Function apiGetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal szWindowText As String, ByVal lLength As Long) As Long
Private Declare Function apiGetWindowThreadProcessId Lib "User32" Alias "GetWindowThreadProcessId" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function apiIsCharAlphaNumericA Lib "User32" Alias "IsCharAlphaNumericA" (ByVal byChar As Byte) As Long
Private Declare Function apiIsIconic Lib "User32" Alias "IsIconic" (ByVal hWnd As Long) As Long
Private Declare Function apiIsWindowVisible Lib "User32" Alias "IsWindowVisible" (ByVal hWnd As Long) As Long
Private Declare Function apiIsZoomed Lib "User32" Alias "IsZoomed" (ByVal hWnd As Long) As Long
Private Declare Function apiLStrCpynA Lib "Kernel32" Alias "lstrcpynA" (ByVal pDestination As String, ByVal pSource As Long, ByVal iMaxLength As Integer) As Long
Private Declare Function apiMessageBox Lib "User32" Alias "MessageBoxA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Declare Function apiOpenIcon Lib "User32" Alias "OpenIcon" (ByVal hWnd As Long) As Long
Private Declare Function apiOpenProcess Lib "Kernel32" Alias "OpenProcess" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function apiPathAddBackslashByPointer Lib "ShlwApi" Alias "PathAddBackslashW" (ByVal lpszPath As Long) As Long
Private Declare Function apiPathAddBackslashByString Lib "ShlwApi" Alias "PathAddBackslashW" (ByVal lpszPath As String) As Long 'http://msdn.microsoft.com/en-us/library/aa155716%28office.10%29.aspx
Private Declare Function apiPostMessage Lib "User32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function apiReadFile Lib "Kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare Function apiRegQueryValue Lib "AdvApi32" Alias "RegQueryValue" (ByVal hKey As Long, ByVal sValueName As String, ByVal dwReserved As Long, ByRef lValueType As Long, ByVal sValue As String, ByRef lResultLen As Long) As Long
Private Declare Function apiSendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function apiSetActiveWindow Lib "User32" Alias "SetActiveWindow" (ByVal hWnd As Long) As Long
Private Declare Function apiSetCurrentDirectoryA Lib "Kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
Private Declare Function apiSetFocus Lib "User32" Alias "SetFocus" (ByVal hWnd As Long) As Long
Private Declare Function apiSetForegroundWindow Lib "User32" Alias "SetForegroundWindow" (ByVal hWnd As Long) As Long
Private Declare Function apiSetLocalTime Lib "Kernel32" Alias "SetLocalTime" (lpSystem As SystemTime) As Long
Private Declare Function apiSetWindowPlacement Lib "User32" Alias "SetWindowPlacement" (ByVal hWnd As Long, ByRef lpwndpl As winPlacement) As Long
Private Declare Function apiSetWindowPos Lib "User32" Alias "SetWindowPos" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function apiSetWindowText Lib "User32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function apiShellExecute Lib "Shell32" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function apiShowWindow Lib "User32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function apiShowWindowAsync Lib "User32" Alias "ShowWindowAsync" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function apiStrCpy Lib "Kernel32" Alias "lstrcpynA" (ByVal pDestination As String, ByVal pSource As String, ByVal iMaxLength As Integer) As Long
Private Declare Function apiStringLen Lib "Kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Function apiStrTrimW Lib "ShlwApi" Alias "StrTrimW" () As Boolean
Private Declare Function apiTerminateProcess Lib "Kernel32" Alias "TerminateProcess" (ByVal hWnd As Long, ByVal uExitCode As Long) As Long
Private Declare Function apiTimeGetTime Lib "Winmm" Alias "timeGetTime" () As Long
Private Declare Function apiVarPtrArray Lib "MsVbVm50" Alias "VarPtr" (Var() As Any) As Long
Private Declare Function apiWaitForSingleObject Lib "Kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Type browseInfo 'used by apiBrowseForFolder
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare Function apiBrowseForFolder Lib "Shell32" Alias "SHBrowseForFolderA" (lpBrowseInfo As browseInfo) As Long
Private Type CHOOSECOLOR 'used by apiChooseColor; http://support.microsoft.com/kb/153929 and http://www.cpearson.com/Excel/Colors.aspx
lStructSize As Long
hWndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As String
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Declare Function apiChooseColor Lib "ComDlg32" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
Private Type FindWindowParameters 'Custom structure for passing in the parameters in/out of the hook enumeration function; could use global variables instead, but this is nicer
strTitle As String 'INPUT
hWnd As Long 'OUTPUT
End Type 'Find a specific window with dynamic caption from a list of all open windows: http://www.everythingaccess.com/tutorials.asp?ID=Bring-an-external-application-window-to-the-foreground
Private Declare Function apiEnumWindows Lib "User32" Alias "EnumWindows" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Type lastInputInfo 'used by apiGetLastInputInfo, getLastInputTime
cbSize As Long
dwTime As Long
End Type
Private Declare Function apiGetLastInputInfo Lib "User32" Alias "GetLastInputInfo" (ByRef plii As lastInputInfo) As Long
Private Type SystemTime
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Declare Sub apiGetLocalTime Lib "Kernel32" Alias "GetLocalTime" (lpSystem As SystemTime)
Private Type pointAPI
X As Long
Y As Long
End Type
Private Type rectAPI
Left_Renamed As Long
Top_Renamed As Long
Right_Renamed As Long
Bottom_Renamed As Long
End Type
Private Type winPlacement
length As Long
flags As Long
showCmd As Long
ptMinPosition As pointAPI
ptMaxPosition As pointAPI
rcNormalPosition As rectAPI
End Type
Private Declare Function apiGetWindowPlacement Lib "User32" Alias "GetWindowPlacement" (ByVal hWnd As Long, ByRef lpwndpl As winPlacement) As Long
Private Type winRect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function apiMoveWindow Lib "User32" Alias "MoveWindow" (ByVal hWnd As Long, xLeft As Long, ByVal yTop As Long, wWidth As Long, ByVal hHeight As Long, ByVal repaint As Long) As Long
#Else ' Win16 = True
#End If
Mac API
マイクロソフトは公式にAPIをサポートしていませんが、いくつかの調査ではより多くの宣言がオンラインで見られる
Mac用Office 2016はサンドボックス化されています
VBAをサポートする他のバージョンのOfficeアプリケーションとは異なり、Macアプリケーション用のOffice 2016はサンドボックス化されています。
サンドボックス処理では、アプリケーションがアプリケーションコンテナ外のリソースにアクセスすることを制限します。これは、ファイルアクセスやプロセス間の通信に関係するアドインやマクロに影響します。次のセクションで説明する新しいコマンドを使用して、サンドボックスの影響を最小限に抑えることができます。 Office 2016 for Macの新しいVBAコマンド
次のVBAコマンドは、Office 2016 for Macに固有の新機能です。
コマンド | に使用 |
---|---|
GrantAccessToMultipleFiles | 一度に複数のファイルにアクセスするユーザーの許可を要求する |
AppleScriptTask | VBから外部AppleScriptスクリプトを呼び出す |
MAC_OFFICE_VERSION | コンパイル時に異なるMacのバージョン間のIFDEF |
Private Declare Function system Lib "libc.dylib" (ByVal command As String) As Long
Private Declare Function popen Lib "libc.dylib" (ByVal command As String, ByVal mode As String) As Long
Private Declare Function pclose Lib "libc.dylib" (ByVal file As Long) As Long
Private Declare Function fread Lib "libc.dylib" (ByVal outStr As String, ByVal size As Long, ByVal items As Long, ByVal stream As Long) As Long
Private Declare Function feof Lib "libc.dylib" (ByVal file As Long) As Long
Private Declare PtrSafe Function popen Lib "libc.dylib" (ByVal command As String, ByVal mode As String) As LongPtr
Private Declare PtrSafe Function pclose Lib "libc.dylib" (ByVal file As LongPtr) As Long
Private Declare PtrSafe Function fread Lib "libc.dylib" (ByVal outStr As String, ByVal size As LongPtr, ByVal items As LongPtr, ByVal stream As LongPtr) As Long
Private Declare PtrSafe Function feof Lib "libc.dylib" (ByVal file As LongPtr) As LongPtr
モニタと画面解像度の合計を取得する
Option Explicit
'GetSystemMetrics32 info: http://msdn.microsoft.com/en-us/library/ms724385(VS.85).aspx
#If Win64 Then
Private Declare PtrSafe Function GetSystemMetrics32 Lib "User32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
#ElseIf Win32 Then
Private Declare Function GetSystemMetrics32 Lib "User32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
#End If
'VBA Wrappers:
Public Function dllGetMonitors() As Long
Const SM_CMONITORS = 80
dllGetMonitors = GetSystemMetrics32(SM_CMONITORS)
End Function
Public Function dllGetHorizontalResolution() As Long
Const SM_CXVIRTUALSCREEN = 78
dllGetHorizontalResolution = GetSystemMetrics32(SM_CXVIRTUALSCREEN)
End Function
Public Function dllGetVerticalResolution() As Long
Const SM_CYVIRTUALSCREEN = 79
dllGetVerticalResolution = GetSystemMetrics32(SM_CYVIRTUALSCREEN)
End Function
Public Sub ShowDisplayInfo()
Debug.Print "Total monitors: " & vbTab & vbTab & dllGetMonitors
Debug.Print "Horizontal Resolution: " & vbTab & dllGetHorizontalResolution
Debug.Print "Vertical Resolution: " & vbTab & dllGetVerticalResolution
'Total monitors: 1
'Horizontal Resolution: 1920
'Vertical Resolution: 1080
End Sub
FTPおよび地域API
modFTP
Option Explicit
Option Compare Text
Option Private Module
'http://msdn.microsoft.com/en-us/library/aa384180(v=VS.85).aspx
'http://www.dailydoseofexcel.com/archives/2006/01/29/ftp-via-vba/
'http://www.15seconds.com/issue/981203.htm
'Open the Internet object
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" ( _
ByVal sAgent As String, _
ByVal lAccessType As Long, _
ByVal sProxyName As String, _
ByVal sProxyBypass As String, _
ByVal lFlags As Long _
) As Long
'ex: lngINet = InternetOpen(“MyFTP Control”, 1, vbNullString, vbNullString, 0)
'Connect to the network
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" ( _
ByVal hInternetSession As Long, _
ByVal sServerName As String, _
ByVal nServerPort As Integer, _
ByVal sUsername As String, _
ByVal sPassword As String, _
ByVal lService As Long, _
ByVal lFlags As Long, _
ByVal lContext As Long _
) As Long
'ex: lngINetConn = InternetConnect(lngINet, "ftp.microsoft.com", 0, "anonymous", "[email protected]", 1, 0, 0)
'Get a file
Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" ( _
ByVal hFtpSession As Long, _
ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, _
ByVal fFailIfExists As Boolean, _
ByVal dwFlagsAndAttributes As Long, _
ByVal dwFlags As Long, _
ByVal dwContext As Long _
) As Boolean
'ex: blnRC = FtpGetFile(lngINetConn, "dirmap.txt", "c:\dirmap.txt", 0, 0, 1, 0)
'Send a file
Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
( _
ByVal hFtpSession As Long, _
ByVal lpszLocalFile As String, _
ByVal lpszRemoteFile As String, _
ByVal dwFlags As Long, ByVal dwContext As Long _
) As Boolean
'ex: blnRC = FtpPutFile(lngINetConn, “c:\dirmap.txt”, “dirmap.txt”, 1, 0)
'Delete a file
Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" _
( _
ByVal hFtpSession As Long, _
ByVal lpszFileName As String _
) As Boolean
'ex: blnRC = FtpDeleteFile(lngINetConn, “test.txt”)
'Close the Internet object
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
'ex: InternetCloseHandle lngINetConn
'ex: InternetCloseHandle lngINet
Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
( _
ByVal hFtpSession As Long, _
ByVal lpszSearchFile As String, _
lpFindFileData As WIN32_FIND_DATA, _
ByVal dwFlags As Long, _
ByVal dwContent As Long _
) As Long
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_FTP_PATH
cAlternate As String * 14
End Type
'ex: lngHINet = FtpFindFirstFile(lngINetConn, "*.*", pData, 0, 0)
Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
( _
ByVal hFind As Long, _
lpvFindData As WIN32_FIND_DATA _
) As Long
'ex: blnRC = InternetFindNextFile(lngHINet, pData)
Public Sub showLatestFTPVersion()
Dim ftpSuccess As Boolean, msg As String, lngFindFirst As Long
Dim lngINet As Long, lngINetConn As Long
Dim pData As WIN32_FIND_DATA
'init the filename buffer
pData.cFileName = String(260, 0)
msg = "FTP Error"
lngINet = InternetOpen("MyFTP Control", 1, vbNullString, vbNullString, 0)
If lngINet > 0 Then
lngINetConn = InternetConnect(lngINet, FTP_SERVER_NAME, FTP_SERVER_PORT, FTP_USER_NAME, FTP_PASSWORD, 1, 0, 0)
If lngINetConn > 0 Then
FtpPutFile lngINetConn, "C:\Tmp\ftp.cls", "ftp.cls", FTP_TRANSFER_BINARY, 0
'lngFindFirst = FtpFindFirstFile(lngINetConn, "ExcelDiff.xlsm", pData, 0, 0)
If lngINet = 0 Then
msg = "DLL error: " & Err.LastDllError & ", Error Number: " & Err.Number & ", Error Desc: " & Err.Description
Else
msg = left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
End If
InternetCloseHandle lngINetConn
End If
InternetCloseHandle lngINet
End If
MsgBox msg
End Sub
modRegional:
Option Explicit
Private Const LOCALE_SDECIMAL = &HE
Private Const LOCALE_SLIST = &HC
Private Declare Function GetLocaleInfo Lib "Kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Declare Function SetLocaleInfo Lib "Kernel32" Alias "SetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Boolean
Private Declare Function GetUserDefaultLCID% Lib "Kernel32" ()
Public Function getTimeSeparator() As String
getTimeSeparator = Application.International(xlTimeSeparator)
End Function
Public Function getDateSeparator() As String
getDateSeparator = Application.International(xlDateSeparator)
End Function
Public Function getListSeparator() As String
Dim ListSeparator As String, iRetVal1 As Long, iRetVal2 As Long, lpLCDataVar As String, Position As Integer, Locale As Long
Locale = GetUserDefaultLCID()
iRetVal1 = GetLocaleInfo(Locale, LOCALE_SLIST, lpLCDataVar, 0)
ListSeparator = String$(iRetVal1, 0)
iRetVal2 = GetLocaleInfo(Locale, LOCALE_SLIST, ListSeparator, iRetVal1)
Position = InStr(ListSeparator, Chr$(0))
If Position > 0 Then ListSeparator = Left$(ListSeparator, Position - 1) Else ListSeparator = vbNullString
getListSeparator = ListSeparator
End Function
Private Sub ChangeSettingExample() 'change the setting of the character displayed as the decimal separator.
Call SetLocalSetting(LOCALE_SDECIMAL, ",") 'to change to ","
Stop 'check your control panel to verify or use the GetLocaleInfo API function
Call SetLocalSetting(LOCALE_SDECIMAL, ".") 'to back change to "."
End Sub
Private Function SetLocalSetting(LC_CONST As Long, Setting As String) As Boolean
Call SetLocaleInfo(GetUserDefaultLCID(), LC_CONST, Setting)
End Function