Zip file using different user credentials

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top