VBスクリプトが別のワークシートにスクリプトの出力を書き込む質問

Question

当社の異なるベンダーのOrgのために、ADユーザーのCSVファイルリストを生成するスクリプトを作成しました。今度は、C：で保存した別のExcelファイルの第2タブ（ワークシート）にスクリプトの出力を追加します。

スクリプトの先頭に次のコードを追加して、別のExcelファイルの2番目のタブ（ワークシート）に出力が印刷されるようにしましたが、複数のエラーが発生しています。

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文の後に追加して、他のワークブックの2番目のワークシートに出力を追加することもできますか？私は一種新しく、これについて混乱しています。私が見ることができる

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 

Answer 1

一つの潜在的な問題は、あなたが最初にエクセルのホールドを取得していないことである。

コードの最初の数行は、おそらく次のようになります。

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 

あなたはいつでもデータでその関数を呼び出すことができますuがしたい：助けを

'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