IN THE SPOTLIGHT: MDE to MDB Conversion Service
(also supports: ACCDE to ACCDB, ADE to ADP, etc)
IN THE SPOTLIGHT: Access Database Repair Service
An in-depth repair service for corrupt Microsoft Access files
IN THE SPOTLIGHT: vbWatchdog
VBA error handling just got easier...
" vbWatchdog is off the chart. It solves a long standing problem of how to consolidate error handling into one global location and avoid repetitious code within applications. "
- Joe Anderson,
Microsoft Access MVP
Meet Shady, the vbWatchdog mascot watching over your VBA code →
(courtesy of Crystal Long, Microsoft Access MVP)
IN THE SPOTLIGHT: vbMAPI
An Outlook / MAPI code library for VBA, .NET and C# projects
Get emails out to your customers reliably, and without hassle, every single time.
Use vbMAPI alongside Microsoft Outlook to add professional emailing capabilities to your projects.
IN THE SPOTLIGHT: Code Protector
Standard compilation to MDE/ACCDE format is flawed and reversible.
Public Sub EnumerateProfileServices()
Dim Session As vbMAPI_Session
Dim Profile As vbMAPI_Profile
Dim Service As vbMAPI_ProfileService
' Create a vbMAPI Session instance. No need to logon for this
Set Session = vbMAPI_Init.NewSession
' Enumerate and print the names of all services in all profiles
For Each Profile In Session.Profiles
Debug.Print Profile.Name & "------------------------------"
For Each Service In Profile.Services
Debug.Print vbTab & Service.ServiceName
Next
Next
End Sub
Public Sub EnumerateProfileServices()
Dim Session As vbMAPI_Session
Dim Profile As vbMAPI_Profile
Dim Service As vbMAPI_ProfileService
' Create a vbMAPI Session instance. No need to logon for this
Session = vbMAPI_Init.NewSession
' Enumerate and print the names of all services in all profiles
For Each Profile In Session.Profiles
Debug.Print(Profile.Name & "------------------------------")
For Each Service In Profile.Services
Debug.Print(vbTab & Service.ServiceName)
Next
Next
End Sub
public void EnumerateProfileServices()
{
// Create a vbMAPI Session instance. No need to logon for this
vbMAPI_Session Session = vbMAPI_Init.NewSession();
// Enumerate and print the names of all services in all profiles
foreach(vbMAPI_Profile Profile in Session.Profiles)
{
System.Diagnostics.Debug.Print(Profile.Name + "------------------------------");
foreach(vbMAPI_ProfileService Service in Profile.Services)
{
System.Diagnostics.Debug.Print("\t" + Service.ServiceName);
};
};
}
Public Sub EnumeratePSTFilesInAllProfiles()
Dim Session As vbMAPI_Session
Dim Profile As vbMAPI_Profile
Dim Service As vbMAPI_ProfileService
' Create a vbMAPI Session instance. No need to logon for this
Set Session = vbMAPI_Init.NewSession
' Enumerate and print the names of all services in all profiles
For Each Profile In Session.Profiles
Debug.Print Profile.Name & "------------------------------"
For Each Service In Profile.Services
If Service.ServiceName = "MSPST MS" Or _
Service.ServiceName = "MSUPST MS" Then
With Service.Providers(0)
Debug.Print vbTab & .Properties(PR_PST_PATH)
End With
End If
Next
Next
End Sub
Public Sub EnumeratePSTFilesInAllProfiles()
Dim Session As vbMAPI_Session
Dim Profile As vbMAPI_Profile
Dim Service As vbMAPI_ProfileService
' Create a vbMAPI Session instance. No need to logon for this
Session = vbMAPI_Init.NewSession
' Enumerate and print the names of all services in all profiles
For Each Profile In Session.Profiles
Debug.Print(Profile.Name & "------------------------------")
For Each Service In Profile.Services
If Service.ServiceName = "MSPST MS" Or _
Service.ServiceName = "MSUPST MS" Then
With Service.Providers(0)
Debug.Print(vbTab & .Properties(EnumMAPIPropTagSymbols.PR_PST_PATH).Value)
End With
End If
Next
Next
End Sub
public void EnumeratePSTFilesInAllProfiles()
{
vbMAPI_Session Session;
// Create a vbMAPI Session instance. No need to logon for this
Session = vbMAPI_Init.NewSession();
// Enumerate and print the names of all services in all profiles
foreach(vbMAPI_Profile Profile in Session.Profiles)
{
System.Diagnostics.Debug.Print(Profile.Name + "------------------------------");
foreach(vbMAPI_ProfileService Service in Profile.Services)
{
if ((Service.ServiceName == "MSPST MS") ||
(Service.ServiceName == "MSUPST MS"))
{
System.Diagnostics.Debug.Print("\t" +
Service.Providers.Item(0).Properties.Item(EnumMAPIPropTagSymbols.PR_PST_PATH).Value);
};
};
};
}
Public Sub EnumerateAllProvidersInAllServices()
Dim Session As vbMAPI_Session
Dim Profile As vbMAPI_Profile
Dim Service As vbMAPI_ProfileService
Dim Provider As vbMAPI_ProfileProvider
' Create a vbMAPI Session instance. No need to logon for this
Set Session = vbMAPI_Init.NewSession
' Enumerate and print the names of all services in all profiles
For Each Profile In Session.Profiles
Debug.Print Profile.Name & "-----------------"
For Each Service In Profile.Services
Debug.Print vbTab & Service.ServiceName & "-----------"
For Each Provider In Service.Providers
Debug.Print vbTab & vbTab & Provider.DisplayName
Next
Next
Next
End Sub
Public Sub EnumerateAllProvidersInAllServices()
Dim Session As vbMAPI_Session
Dim Profile As vbMAPI_Profile
Dim Service As vbMAPI_ProfileService
Dim Provider As vbMAPI_ProfileProvider
' Create a vbMAPI Session instance. No need to logon for this
Session = vbMAPI_Init.NewSession
' Enumerate and print the names of all services in all profiles
For Each Profile In Session.Profiles
Debug.Print(Profile.Name & "-----------------")
For Each Service In Profile.Services
Debug.Print(vbTab & Service.ServiceName & "-----------")
For Each Provider In Service.Providers
Debug.Print(vbTab & vbTab & Provider.DisplayName)
Next
Next
Next
End Sub
public void EnumerateAllProvidersInAllServices()
{
vbMAPI_Session Session;
// Create a vbMAPI Session instance. No need to logon for this
Session = vbMAPI_Init.NewSession();
// Enumerate and print the names of all services in all profiles
foreach(vbMAPI_Profile Profile in Session.Profiles)
{
System.Diagnostics.Debug.Print(Profile.Name + "-----------------");
foreach(vbMAPI_ProfileService Service in Profile.Services)
{
System.Diagnostics.Debug.Print("\t" + Service.ServiceName + "-----------");
foreach(vbMAPI_ProfileProvider Provider in Service.Providers)
{
System.Diagnostics.Debug.Print("\t\t" + Provider.DisplayName);
};
};
};
}
Public Sub CreateProfileToAccessPSTFile(ProfileName As String, _
PSTFilePath As String, _
Optional Password)
Dim Session As vbMAPI_Session
' Create a vbMAPI Session instance. No need to logon for this
Set Session = vbMAPI_Init.NewSession
With Session.Profiles.Add(ProfileName, False, False)
With .Services.Add("MSPST MS", "vbMAPI PST").Configure
.PST_FilePath = PSTFilePath
'.PST_EncryptionType = PSTEncryption_Best
If Not IsMissing(Password) Then
.PST_OpenPassword = Password
.PST_NewPassword = Password
.PST_RememberPassword = True
End If
.Execute ShowUI_Never
End With
End With
End Sub
Public Sub CreateProfileToAccessPSTFile(ByVal ProfileName As String, _
ByVal PSTFilePath As String, _
Optional ByVal Password As String = "")
Dim Session As vbMAPI_Session
' Create a vbMAPI Session instance. No need to logon for this
Session = vbMAPI_Init.NewSession
With Session.Profiles.Add(ProfileName, False, False)
With .Services.Add("MSPST MS", "vbMAPI PST").Configure
.PST_FilePath = PSTFilePath
'.PST_EncryptionType = PSTEncryption_Best
If Password.Length > 0 Then
.PST_OpenPassword = Password
.PST_NewPassword = Password
.PST_RememberPassword = True
End If
.Execute(EnumShowUI.ShowUI_Never)
End With
End With
End Sub
public void CreateProfileToAccessPSTFile(string ProfileName,
string PSTFilePath,
string Password)
{
vbMAPI_Session Session;
vbMAPI_Profile Profile;
vbMAPI_ProfileServiceConfig ServiceConfig;
// Create a vbMAPI Session instance. No need to logon for this
Session = vbMAPI_Init.NewSession();
Profile = Session.Profiles.Add(ProfileName, false, false, 0);
ServiceConfig = Profile.Services.Add("MSPST MS", "vbMAPI PST", false, 0).Configure;
ServiceConfig.PST_FilePath = PSTFilePath;
//.PST_EncryptionType = PSTEncryption_Best
if (Password.Length > 0)
{
ServiceConfig.PST_OpenPassword = Password;
ServiceConfig.PST_NewPassword = Password;
ServiceConfig.PST_RememberPassword = true;
};
ServiceConfig.Execute(EnumShowUI.ShowUI_Never, 0);
}
Public Sub CreateOrReuseProfileToAccessPSTFile(ProfileName As String, _
PSTFilePath As String, _
Optional Password)
Dim Session As vbMAPI_Session
Dim Profile As vbMAPI_Profile
Dim Provider As vbMAPI_ProfileProvider
Dim Service As vbMAPI_ProfileService
' Create a vbMAPI Session instance. No need to logon for this
Set Session = vbMAPI_Init.NewSession
On Error Resume Next
Set Profile = Session.Profiles(ProfileName)
If Not Profile Is Nothing Then
' The profile already exists.
' Check if the PST file is already configured in it.
For Each Service In Profile.Services
For Each Provider In Service.Providers
If Provider.Properties(PR_PST_PATH) = PSTFilePath Then
' The PST file is already configured on this profile
Exit Sub
End If
Next
Next
' If we get here then the profile exists,
' but the PST file isn't configured on it...
Else
' The profile doesn't yet exist. Create it.
Set Profile = Session.Profiles.Add(ProfileName, False, False)
End If
On Error Goto 0
Set Service = Profile.Services.Add("MSPST MS", "vbMAPI PST")
With Service.Configure
.PST_FilePath = PSTFilePath
'.PST_EncryptionType = PSTEncryption_Best
If Not IsMissing(Password) Then
.PST_OpenPassword = Password
.PST_NewPassword = Password
.PST_RememberPassword = True
End If
.Execute ShowUI_Never
End With
End Sub
Public Sub CreateOrReuseProfileToAccessPSTFile(ByVal ProfileName As String, _
ByVal PSTFilePath As String, _
ByVal Password As String)
Dim Session As vbMAPI_Session
Dim Profile As vbMAPI_Profile
Dim Provider As vbMAPI_ProfileProvider
Dim Service As vbMAPI_ProfileService
' Create a vbMAPI Session instance. No need to logon for this
Session = vbMAPI_Init.NewSession
On Error Resume Next
Profile = Session.Profiles(ProfileName)
If Not Profile Is Nothing Then
' The profile already exists.
' Check if the PST file is already configured in it.
For Each Service In Profile.Services
For Each Provider In Service.Providers
If Provider.Properties(EnumMAPIPropTagSymbols.PR_PST_PATH).Value = PSTFilePath Then
' The PST file is already configured on this profile
Exit Sub
End If
Next
Next
' If we get here then the profile exists,
' but the PST file isn't configured on it...
Else
' The profile doesn't yet exist. Create it.
Profile = Session.Profiles.Add(ProfileName, False, False)
End If
On Error Goto 0
Service = Profile.Services.Add("MSPST MS", "vbMAPI PST")
With Service.Configure
.PST_FilePath = PSTFilePath
'.PST_EncryptionType = PSTEncryption_Best
If Password.Length > 0 Then
.PST_OpenPassword = Password
.PST_NewPassword = Password
.PST_RememberPassword = True
End If
.Execute(EnumShowUI.ShowUI_Never)
End With
End Sub
public void CreateOrReuseProfileToAccessPSTFile(string ProfileName,
string PSTFilePath,
string Password)
{
vbMAPI_Session Session;
vbMAPI_Profile Profile;
// Create a vbMAPI Session instance. No need to logon for this
Session = vbMAPI_Init.NewSession();
try
{
Profile = Session.Profiles.Item(ProfileName);
}
catch
{
// The profile doesn't yet exist. Create it.
Profile = Session.Profiles.Add(ProfileName, false, false, 0);
};
// Check if the PST file is already configured on the profile
foreach(vbMAPI_ProfileService Service in Profile.Services)
{
foreach(vbMAPI_ProfileProvider Provider in Service.Providers)
{
if (Provider.Properties.Item(EnumMAPIPropTagSymbols.PR_PST_PATH).Value == PSTFilePath)
{
// The PST file is already configured on this profile
return;
};
};
};
// configure the PST on this profile
vbMAPI_ProfileServiceConfig ServiceConfig = Profile.Services.Add("MSPST MS", "vbMAPI PST", false, 0).Configure;
ServiceConfig.PST_FilePath = PSTFilePath;
//.PST_EncryptionType = PSTEncryption_Best
if (Password.Length > 0)
{
ServiceConfig.PST_OpenPassword = Password;
ServiceConfig.PST_NewPassword = Password;
ServiceConfig.PST_RememberPassword = true;
};
ServiceConfig.Execute(EnumShowUI.ShowUI_Never, 0);
}
Public Sub SetupExchange(ProfileName As String, _
Username As String, _
Server As String, _
Optional EncryptConnection As Boolean, _
Optional ROH_ProxyServer, _
Optional ROH_PrincipalName)
Dim Session As vbMAPI_Session
Dim Profile As vbMAPI_Profile
Dim Service As vbMAPI_ProfileService
' Create a vbMAPI Session instance. No need to logon for this
Set Session = vbMAPI_Init.NewSession
On Error Resume Next
Set Profile = Session.Profiles(ProfileName)
If Profile Is Nothing Then
' The profile doesn't yet exist. Create it.
Set Profile = Session.Profiles.Add(ProfileName, False, False)
Profile.IsDefault = True ' Make the profile the default
End If
On Error Goto 0
' Add the exchange service, without showing any UI
Set Service = Profile.Services.Add("MSEMS", "vbMAPI Exchange", False)
' Setup advanced properties, such as RPC-over-HTTP here:
With Service.Profile.GlobalProfileSection
If Not IsMissing(ROH_PrincipalName) Then
.Item(PR_ROH_FLAGS) = 7 ' USE ROH, SSLONLY, ROHFLAGS_MUTUAL_AUTH
.Item(PR_ROH_PROXY_AUTH_SCHEME) = 1 ' ROHAUTH_BASIC=1, ROHAUTH_NTLM=2
.Item(PR_ROH_PROXY_PRINCIPAL_NAME) = ROH_PrincipalName ' e.g. "msstd:myserver.co.uk"
.Item(PR_ROH_PROXY_SERVER) = ROH_ProxyServer ' e.g. "myserver.co.uk"
End If
If EncryptConnection Then .Item(PR_PROFILE_UI_STATE) = &H4100 ' Encrypts the connection
.Item(PR_PROFILE_AUTH_PACKAGE) = 9
End With
' Now configure the exchange service...
With Service.Configure
.EX_UnresolvedUsername = Username ' e.g. "EverythingAccess.com Sales"
.EX_UnresolvedServer = Server ' e.g. "SERVER-BLAH"
.Execute ShowUI_Never
End With
End Sub
Public Sub SetupExchange(ProfileName As String, _
Username As String, _
Server As String, _
Optional EncryptConnection As Boolean, _
Optional ROH_ProxyServer As String = "", _
Optional ROH_PrincipalName As String = "")
Dim Session As vbMAPI_Session
Dim Profile As vbMAPI_Profile
Dim Service As vbMAPI_ProfileService
' Create a vbMAPI Session instance. No need to logon for this
Session = vbMAPI_Init.NewSession
On Error Resume Next
Profile = Session.Profiles(ProfileName)
If Profile Is Nothing Then
' The profile doesn't yet exist. Create it.
Profile = Session.Profiles.Add(ProfileName, False, False)
Profile.IsDefault = True ' Make the profile the default
End If
On Error Goto 0
' Add the exchange service, without showing any UI
Service = Profile.Services.Add("MSEMS", "vbMAPI Exchange", False)
' Setup advanced properties, such as RPC-over-HTTP here:
With Service.Profile.GlobalProfileSection
If ROH_PrincipalName.Length > 0 Then
.Item(EnumMAPIPropTagSymbols.PR_ROH_FLAGS).Value = 7 ' USE ROH, SSLONLY, ROHFLAGS_MUTUAL_AUTH
.Item(EnumMAPIPropTagSymbols.PR_ROH_PROXY_AUTH_SCHEME).Value = 1 ' ROHAUTH_BASIC=1, ROHAUTH_NTLM=2
.Item(EnumMAPIPropTagSymbols.PR_ROH_PROXY_PRINCIPAL_NAME).Value = ROH_PrincipalName
.Item(EnumMAPIPropTagSymbols.PR_ROH_PROXY_SERVER).Value = ROH_ProxyServer
End If
If EncryptConnection Then .Item(EnumMAPIPropTagSymbols.PR_PROFILE_UI_STATE).Value = &H4100
.Item(EnumMAPIPropTagSymbols.PR_PROFILE_AUTH_PACKAGE).Value = 9
End With
' Now configure the exchange service...
With Service.Configure
.EX_UnresolvedUsername = Username ' e.g. "EverythingAccess.com Sales"
.EX_UnresolvedServer = Server ' e.g. "SERVER-BLAH"
.Execute(EnumShowUI.ShowUI_Never)
End With
End Sub
public void SetupExchange(string ProfileName,
string Username,
string Server,
bool EncryptConnection,
string ROH_ProxyServer,
string ROH_PrincipalName)
{
vbMAPI_Session Session;
vbMAPI_Profile Profile;
vbMAPI_ProfileService Service;
// Create a vbMAPI Session instance. No need to logon for this
Session = vbMAPI_Init.NewSession();
try
{
Profile = Session.Profiles.Item(ProfileName);
}
catch
{
// The profile doesn't yet exist. Create it.
Profile = Session.Profiles.Add(ProfileName, false, false, 0);
Profile.IsDefault = true; // Make the profile the default
};
// Add the exchange service, without showing any UI
Service = Profile.Services.Add("MSEMS", "vbMAPI Exchange", false, 0);
// Setup advanced properties, such as RPC-over-HTTP here:
vbMAPI_Properties Props = Service.Profile.GlobalProfileSection;
if (ROH_PrincipalName.Length > 0)
{
Props.Item(EnumMAPIPropTagSymbols.PR_ROH_FLAGS).Value = 7; // USE ROH, SSLONLY, ROHFLAGS_MUTUAL_AUTH
Props.Item(EnumMAPIPropTagSymbols.PR_ROH_PROXY_AUTH_SCHEME).Value = 1; // ROHAUTH_BASIC=1, ROHAUTH_NTLM=2
Props.Item(EnumMAPIPropTagSymbols.PR_ROH_PROXY_PRINCIPAL_NAME).Value = ROH_PrincipalName;
Props.Item(EnumMAPIPropTagSymbols.PR_ROH_PROXY_SERVER).Value = ROH_ProxyServer;
};
if (EncryptConnection) Props.Item(EnumMAPIPropTagSymbols.PR_PROFILE_UI_STATE).Value = 0x4100;
Props.Item(EnumMAPIPropTagSymbols.PR_PROFILE_AUTH_PACKAGE).Value = 9;
// Now configure the exchange service...
vbMAPI_ProfileServiceConfig ServiceConfig = Service.Configure;
ServiceConfig.EX_UnresolvedUsername = Username; // e.g. "EverythingAccess.com Sales"
ServiceConfig.EX_UnresolvedServer = Server; // e.g. "SERVER-BLAH"
ServiceConfig.Execute(EnumShowUI.ShowUI_Never, 0);
}
Public Function GetArchivePSTOfProfile(ProfileName As String) As String
Dim Session As vbMAPI_Session
Dim ProfSection As vbMAPI_Properties
' Create a vbMAPI Session instance. No need to logon for this
Set Session = vbMAPI_Init.NewSession
Const ProfSectionUID = "{00020D0A-0000-0000-C000-000000000046}"
' Profile Sections are collections of properties, so we use vbMAPI_Properties
With Session.Profiles(ProfileName)
Set ProfSection = .OpenProfileSection(ProfSectionUID)
GetArchivePSTOfProfile = ProfSection(&H324001E)
End With
End Function
Public Function GetArchivePSTOfProfile(ProfileName As String) As String
Dim Session As vbMAPI_Session
Dim ProfSection As vbMAPI_Properties
' Create a vbMAPI Session instance. No need to logon for this
Session = vbMAPI_Init.NewSession
Const ProfSectionUID = "{00020D0A-0000-0000-C000-000000000046}"
' Profile Sections are collections of properties, so we use vbMAPI_Properties
With Session.Profiles(ProfileName)
ProfSection = .OpenProfileSection(ProfSectionUID)
GetArchivePSTOfProfile = ProfSection(&H324001E).Value
End With
End Function
public string GetArchivePSTOfProfile(string ProfileName)
{
vbMAPI_Session Session;
vbMAPI_Properties ProfSection;
vbMAPI_Profile Profile;
// Create a vbMAPI Session instance. No need to logon for this
Session = vbMAPI_Init.NewSession();
const string ProfSectionUID = "{00020D0A-0000-0000-C000-000000000046}";
// Profile Sections are collections of properties, so we use vbMAPI_Properties
Profile = Session.Profiles.Item(ProfileName);
ProfSection = Profile.OpenProfileSection(ProfSectionUID);
return (string)ProfSection.Item((EnumMAPIPropTagSymbols)0x324001E).Value;
}
TWINBASIC LTD (Company No. 16590181, VAT No. GB497509439)
Terms | Privacy | Sitemap | X (Twitter)