TerminalServer

Public Declare Function TermServerConfig Lib "wtsapi32" Alias _
"WTSSetUserConfigA" (ByVal pServername As String, _
ByVal pUserName As String, ByVal WTSConfigClass As WTS_CONFIG_CLASS, _
ByVal pBuffer As String, ByRef DataLength As Long) As Boolean
Enum WTS_CONFIG_CLASS

WTSUserConfigInitialProgram
WTSUserConfigWorkingDirectory
WTSUserConfigfInheritInitialProgram
WTSUserConfigfAllowLogonTerminalServer
WTSUserConfigTimeoutSettingsConnections
WTSUserConfigTimeoutSettingsDisconnections
WTSUserConfigTimeoutSettingsIdle
WTSUserConfigfDeviceClientDrives
WTSUserConfigfDeviceClientPrinters
WTSUserConfigfDeviceClientDefaultPrinter
WTSUserConfigBrokenTimeoutSettings
WTSUserConfigReconnectSettings
WTSUserConfigModemCallbackSettings
WTSUserConfigModemCallbackPhoneNumber
WTSUserConfigShadowingSettings
WTSUserConfigTerminalServerProfilePath
WTSUserConfigTerminalServerHomeDir
WTSUserConfigTerminalServerHomeDirDrive
WTSUserConfigfTerminalServerRemoteHomeDir
End Enum
Private Sub Command1_Click()
Dim ProfilePath As String
Dim HomePath As String
Dim HomeDir As String
ProfilePath = "\\<SERVER-NAME>\profiles\%username%"
HomePath = "\\<SERVER-NAME>\home\%username%"
HomeDir = "<LETTER-OF-DRIVE:"
If (TermServerConfig("<DOMAIN-SERVER-NAME>", <USER-NAME>), WTSUserConfigTerminalServerProfilePath, ProfilePath, 80)) = False Then
MsgBox "Was unable To change the Profile Path."
End If
If (TermServerConfig("<DOMAIN-SERVER-NAME>", <USER-NAME>, WTSUserConfigTerminalServerHomeDir, HomePath, 80)) = False Then
MsgBox "Was unable To change the Home Path."
End If
If (TermServerConfig("<DOMAIN-SERVER-NAME>", <USER-NAME>, WTSUserConfigTerminalServerHomeDirDrive, HomeDir, 5)) = False Then
MsgBox "Was unable To change the Home Directory."
Else
MsgBox "Update To the Profile Path and Home Directory of " & <USER-NAME> & " is successful."
End If
End Sub