我编写了一个脚本，为我们公司的不同供应商组织生成AD用户的CSV文件列表。现在我想将下面脚本的输出添加到我在C：中保存的另一个Excel文件的第二个选项卡（工作表）中。
我在脚本的开头添加了以下代码，以便将输出打印到另一个Excel文件的第二个选项卡（工作表），但是我收到了多个错误。代码段如下： -
Option Explicit
Dim xL
Dim Targetbook
Set Targetbook = xl.workbooks.open("C:\Users\achowdhury\Desktop\Projects\Project automation\IM controls\Iuc.xlsx")
Dim Targetsheet
Set Targetsheet = targetbook.worksheets("IM AD users")
Dim t
Set t = targetsheet.range("a1")
但是当我在上面附加代码片段并运行代码时，我收到了多个VBScript编译错误。我在这里做的错误是什么？或者我也可以在count = count +1语句之后添加以将输出附加到Other Workbook的第二工作表？我有点新鲜，对此感到困惑。
Option Explicit
Dim xL
Dim Targetbook
Set Targetbook = xl.workbooks.open("C:\Users\achowdhury\Desktop\Projects\Project automation\IM controls\Iuc.xlsx")
Dim Targetsheet
Set Targetsheet = targetbook.worksheets("IM AD users")
Dim t
Set t = targetsheet.range("a1")
Dim objConnection,objCommand,objRecordSet,objUser,ObjFSO, InitFSO,objdialog,thisday,intreturn,OutputFile,myprompt
Dim intCounter,strfname,strDN,arrPath,stroutput,objoutput,Account_locked,Objclass,ObjMail
Dim StrEmpType,IntUAC,UserStatus,slogin,Last_Logon_timestamp,Last_Login,Last_pwd_changed,PWD_Never_Expire,objLastLogon,intLastLogonTime,intLastLogon,User_must_change_pwd
Dim objShell
Dim strFileName
Dim strFilePath
Dim objFile
Dim manager,manager1,manager2,IMSite,IMSite1,IMSite2,count
Const ADS_SCOPE_SUBTREE = 2
Const ForWriting = 2
Const ADS_UF_ACCOUNTDISABLE = 2
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Const ADS_UF_PASSWD_NOTREQD = &H0020
Const ADS_UF_PASSWORD_EXPIRED = 8388608
Const ADS_UF_LOCKOUT= 16
' Declare Option Constants
'------------------------
Const BIF_EDITBOX = &H10
Const BIF_NONEWFOLDER = &H0200
Const BIF_RETURNONLYFSDIRS = &H1
Dim strprompt, intoptions,strroot,strfolderpath
' Setup connection to AD
'------------------------
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
' Specify the output file.
'-----------------------------
Msgbox " This script will generate a list of all IM AD users that are into the IM OU in the imaje.intra domain and that are enabled." & vbnewline & vbnewline _
& "You will be prompted to enter the location where to store the output file." _
& vbnewline & vbnewline & " Just browse the folder where you want to save it " _
& vbnewline & vbnewline & " You will be notified when the script will be completed . Press OK to continue"
' Generate the output filename with the date
'-------------------------------------------
thisday=Year(Date) & Right("0" & Month(Date),2) & Right("0" & Day(Date),2)
strPrompt = "Please select the folder where to store the final output file."
intOptions = BIF_RETURNONLYFSDIRS + BIF_EDITBOX + BIF_NONEWFOLDER
' Return the path, e.g. C:\
strFolderPath = Browse4Folder(strPrompt, intOptions, "")
OutputFile = strFolderPath & "\List_IM_AD_users_" & thisday & ".csv"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objoutput = objFSO.CreateTextFile(OutputFile)
Msgbox " Press OK to start extracting Active Directory information for IM Users into " & OutputFile & vbnewline & vbnewline _
& " You'll be notified when the script will be completed !"
' Set paging file higher to accommodate lots of AD records
'-------------------------------------------------------------
objCommand.Properties("Page Size") = 40000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
'Prepare the LDAP command
'--------------------------
objCommand.CommandText = "SELECT AdsPath FROM 'LDAP://OU=IM,OU=MIUsers,OU=MI,DC=Imaje,DC=intra' WHERE objectCategory='user'"
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
' Read the Entire AD domain for objectCategory=user and write the various fields into the output file
'-----------------------------------------------------------------------------------------------------
objOutput.Write "SamAccountName;GivenName;sn;DisplayName;E-mail @;IM Site;Exists in IM list;IM location;Title;Country;Manager;employeeID;Account locked;Last Logon;LastLogon timestamp;Pwd Never Expires;Last PWD Change;User_must_change_pwd;User creation date;User Change Date;Description;DN" & vbcrlf
count=1
Do Until objRecordSet.EOF
Userstatus="Enabled"
Set objUser = GetObject(objRecordSet.Fields("AdsPath").Value)
' Get status of the User ( disabled or not , pwd required or Not , User must change pwd)
'-------------------------------------------------------------------------------------------
intUAC=ObjUser.userAccountControl
If intUAC AND ADS_UF_ACCOUNTDISABLE Then
Userstatus="Disabled"
End If
If intUAC AND ADS_UF_DONT_EXPIRE_PASSWD Then
PWD_Never_Expire="Yes"
Else
pwd_never_expire="No"
End If
If intUAC AND ADS_UF_PASSWORD_EXPIRED Then
User_must_change_pwd="Yes"
Else
User_must_change_pwd="No"
End If
If intUAC AND ADS_UF_LOCKOUT Then
Account_locked="Yes"
Else
Account_locked="No"
End If
' Get LastLogonTimestamp , LastLogon, LastPwdChange of the User
'------------------------------------------------------------------
On Error Resume Next
Set objLastLogon = objUser.Get("lastLogonTimestamp")
intLastLogonTime = objLastLogon.HighPart * (2^32) + objLastLogon.LowPart
intLastLogonTime = intLastLogonTime / (60 * 10000000)
intLastLogonTime = intLastLogonTime / 1440
Last_Logon_timestamp=intLastLogonTime + #1/1/1601#
Set objLastLogon = objUser.Get("lastLogon")
intLastLogon = objLastLogon.HighPart * (2^32) + objLastLogon.LowPart
intLastLogon = intLastLogon / (60 * 10000000)
intLastLogon = intLastLogon / 1440
Last_Login=intLastLogon + #1/1/1601#
On Error Goto 0
On Error Resume Next
sLogin = objUser.passwordLastChanged
If Err = 0 Then
Last_pwd_changed=sLogin
Else
Last_pwd_changed="Never"
End If
On Error Goto 0
ObjClass = objUser.Class
ObjMail = objUser.Mail
manager = ""
IMSite=""
If ObjClass = "user" and userstatus = "Enabled" then
On Error Resume Next
manager1= split(objUser.Manager,",")
manager = manager1(0)
manager2=split(manager,"=")
manager = manager2(1)
IMSite1 = InStr(ObjUser.distinguishedName,",OU=IM")
IMSite2 = Mid (ObjUser.distinguishedName,IMSite1-12,12)
IMSite1 = split(IMSite2,"=")
IMSite = IMSite1(1)
count=count + 1
objOutput.Write objUser.samaccountname &";" & objUser.GivenName &";" & objUser.sn &";" & objUser.DisplayName &";" & ObjMail & ";" & IMSite & _
";=IFERROR(IF(VLOOKUP(E" & count & ",'IM employees'!C:C,1,FALSE)=E" & count & ",""Yes""),""No"")" & ";=IF(G" & count & "=""Yes"",VLOOKUP(E" & _
count & ",'IM employees'!C:D,2,FALSE),""Missing"")" & ";" &ObjUser.Title & ";" & ObjUser.Co & ";" & Manager &";" & objUser.employeeID & ";" & _
Account_locked & ";" & last_Login & ";" & last_Logon_timestamp & ";"& pwd_never_expire & ";"& Last_pwd_Changed & ";" _
& User_must_change_pwd & ";" & objUser.whenCreated & ";" & objUser.whenChanged & ";" & objUser.description &";" & objUser.distinguishedName &";" & vbcrlf
End If
' Next record in recordset
'------------------------------
objRecordSet.MoveNext
Loop
Msgbox " Script is completed ! The file " & OutputFile & " is now ready !! "
'End Script
Function Browse4Folder(strPrompt, intOptions, strRoot)
Dim objFolder, objFolderItem, objShell
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, strPrompt, intOptions, strRoot)
If (objFolder Is Nothing) Then
Browse4Folder = ""
Else
Set objFolderItem = objFolder.Self
Browse4Folder = objFolderItem.Path
Set objFolderItem = Nothing
Set objFolder = Nothing
End If
Set objShell = Nothing
End Function
答案 0 :(得分：0)
我可以看到的一个潜在问题是你没有先获得excel：
前几行代码应该是：
Option Explicit
Dim xL
Set xl = CreateObject("Excel.Application")
Dim Targetbook
Set Targetbook = xl.Workbooks.Open("C:\Users\achowdhury\Desktop\Projects\Project automation\IM controls\Iuc.xlsx")
Dim targetsheet
targetbook.Sheets("IM AD users").Select
Set targetsheet = targetbook.ActiveSheet '<<<i added SET here
除了输入数据非常简单：
Dim currentRow : currentRow = 1
Function RecordData (username,companyCode)
targetsheet.Cells(currentRow,1).Value = companyCode
targetsheet.Cells(currentRow,2).Value = username
currentRow = currentRow + 1
End Function
然后，您可以随时使用数据调用该函数：
RecordData ("2000","bobbyj")
您还需要保存并关闭文件：
'alerts need to be disabled so that you don't get warnings about saving over the file etc. (excel pop ups)
'ALERTS MUST BE TURNED ON AGAIN IMMEDIATELY AS THIS IS A GLOBAL SETTING FOR EXCEL
' - i.e. users will not get warnings about unsaved files etc. when quitting excel normally'
xl.DisplayAlerts = false
targetbook.SaveAs("C:\Users\achowdhury\Desktop\Projects\Project automation\IM controls\Iuc.xlsx")
xl.DisplayAlerts = true
'close workbook now it has been saved - there should be no pop ups'
targetbook.Close()
'release references and close excel'
set targetbook = nothing
set targetsheet = nothing
xl.Quit()
set xl = Nothing