L
Lilibet
I want to zip up a file using MS Access VBA. In production, the zipped file
will exist on a network drive, which will not be accessible to the MS Access
application users. So files must be zipped up, opened, modified, copied and
deleted using different user credentials. To handle this, I am using the
ImpersonateLoggedOnUser function. I don't currently have access to the
network drive. So for testing purposes, I have set up a local user on my
machine with full control permissions for the folder where the file will be
zipped, and reduced my own access to read only.
When I run the code, the zip file gets created, but get an error, "Cannot
create output file", when it attempts to compress the text file into it. I
even gave TestUser admin access to the machine, and I still have this problem.
When I restore my own user account permissions to full control of the
folder, the code worked ok.
I am using Windows XP with WinZip 11.1 installed as the default zip software.
Does anyone have any suggestions?
Function ArchiveFile()
Dim OutputFilePath
Dim FilePath
Dim shell
Dim zipFile
Dim dFolder
Dim fso
Dim zipdata: zipdata = Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) &
String(18, 0)
LogonGenericAcct
OutputFilePath = "C:\TestFolder\Test.zip"
FilePath = "C:\TestFolder\testfile.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set shell = CreateObject("Shell.Application")
Set zipFile = fso.CreateTextFile(OutputFilePath, True)
zipFile.Write zipdata
zipFile.Close
Set dFolder = shell.Namespace(OutputFilePath)
dFolder.CopyHere FilePath
Set fso = Nothing
Set shell = Nothing
ArchiveFile = True
LogoffGenericAcct
End Function
' code taken from
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_23544840.html
Private Declare Function RevertToSelf Lib "advapi32.dll" () As Long
Private Declare Function LogonUser Lib "advapi32.dll" Alias "LogonUserA"
(ByVal lpszUsername As String, ByVal lpszDomain As String, ByVal lpszPassword
As String, ByVal dwLogonType As Long, ByVal dwLogonProvider As Long, phToken
As Long) As Long
Private Declare Function ImpersonateLoggedOnUser Lib "advapi32.dll" (ByVal
hToken As Long) As Long
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Const LOGON32_LOGON_INTERACTIVE = 2
Const LOGON32_PROVIDER_DEFAULT = 0
Public Sub LogonGenericAcct()
Dim strAdminUser As String
Dim strAdminPassword As String
Dim strAdminDomain As String
Dim lngTokenHandle, lngLogonType, lngLogonProvider As Long
Dim blnResult As Boolean
lngLogonType = LOGON32_LOGON_INTERACTIVE
lngLogonProvider = LOGON32_PROVIDER_DEFAULT
strAdminUser = "TestUser"
strAdminPassword = "password"
strAdminDomain = "[EnterComputerName]"
blnResult = LogonUser(strAdminUser, strAdminDomain, strAdminPassword,
lngLogonType, lngLogonProvider, lngTokenHandle)
blnResult = ImpersonateLoggedOnUser(lngTokenHandle)
' for debugging purposes, test to see which user is logged on
fOSUserName
End Sub
Public Sub LogoffGenericAcct()
Dim blnResult As Boolean
blnResult = RevertToSelf()
fOSUserName
End Sub
' test to see which user is logged on
Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If lngX <> 0 Then
fOSUserName = Left$(strUserName, lngLen - 1)
Debug.Print fOSUserName
Else
fOSUserName = ""
End If
End Function
will exist on a network drive, which will not be accessible to the MS Access
application users. So files must be zipped up, opened, modified, copied and
deleted using different user credentials. To handle this, I am using the
ImpersonateLoggedOnUser function. I don't currently have access to the
network drive. So for testing purposes, I have set up a local user on my
machine with full control permissions for the folder where the file will be
zipped, and reduced my own access to read only.
When I run the code, the zip file gets created, but get an error, "Cannot
create output file", when it attempts to compress the text file into it. I
even gave TestUser admin access to the machine, and I still have this problem.
When I restore my own user account permissions to full control of the
folder, the code worked ok.
I am using Windows XP with WinZip 11.1 installed as the default zip software.
Does anyone have any suggestions?
Function ArchiveFile()
Dim OutputFilePath
Dim FilePath
Dim shell
Dim zipFile
Dim dFolder
Dim fso
Dim zipdata: zipdata = Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) &
String(18, 0)
LogonGenericAcct
OutputFilePath = "C:\TestFolder\Test.zip"
FilePath = "C:\TestFolder\testfile.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set shell = CreateObject("Shell.Application")
Set zipFile = fso.CreateTextFile(OutputFilePath, True)
zipFile.Write zipdata
zipFile.Close
Set dFolder = shell.Namespace(OutputFilePath)
dFolder.CopyHere FilePath
Set fso = Nothing
Set shell = Nothing
ArchiveFile = True
LogoffGenericAcct
End Function
' code taken from
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_23544840.html
Private Declare Function RevertToSelf Lib "advapi32.dll" () As Long
Private Declare Function LogonUser Lib "advapi32.dll" Alias "LogonUserA"
(ByVal lpszUsername As String, ByVal lpszDomain As String, ByVal lpszPassword
As String, ByVal dwLogonType As Long, ByVal dwLogonProvider As Long, phToken
As Long) As Long
Private Declare Function ImpersonateLoggedOnUser Lib "advapi32.dll" (ByVal
hToken As Long) As Long
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Const LOGON32_LOGON_INTERACTIVE = 2
Const LOGON32_PROVIDER_DEFAULT = 0
Public Sub LogonGenericAcct()
Dim strAdminUser As String
Dim strAdminPassword As String
Dim strAdminDomain As String
Dim lngTokenHandle, lngLogonType, lngLogonProvider As Long
Dim blnResult As Boolean
lngLogonType = LOGON32_LOGON_INTERACTIVE
lngLogonProvider = LOGON32_PROVIDER_DEFAULT
strAdminUser = "TestUser"
strAdminPassword = "password"
strAdminDomain = "[EnterComputerName]"
blnResult = LogonUser(strAdminUser, strAdminDomain, strAdminPassword,
lngLogonType, lngLogonProvider, lngTokenHandle)
blnResult = ImpersonateLoggedOnUser(lngTokenHandle)
' for debugging purposes, test to see which user is logged on
fOSUserName
End Sub
Public Sub LogoffGenericAcct()
Dim blnResult As Boolean
blnResult = RevertToSelf()
fOSUserName
End Sub
' test to see which user is logged on
Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If lngX <> 0 Then
fOSUserName = Left$(strUserName, lngLen - 1)
Debug.Print fOSUserName
Else
fOSUserName = ""
End If
End Function