I'm using a continuos build server (Finalbuilder) to create some IIS6 websites. However Finalbuilder does not have an option to set "Enable anonymous access" to true.
Is there a command line option that given a servername, physical directory, etc that I can enable anonymous access from the command line? In IIS7 there is appcmd.exe, but I can't find an equivliant for IIS6.
I used cscript.exe to execute the following:
Dim Siteobj
Dim Site
Dim SiteName
Dim SiteId
Dim SiteLocation
SiteName=WScript.Arguments( 0 )
Set SiteObj = GetObject("IIS://localhost/W3SVC")
for each Site in Siteobj
if Site.keytype="IIsWebServer" Then
if Site.ServerComment = SiteName Then
SiteId=Site.Name
SiteLocation = "IIS://LocalHost/w3svc/" & SiteId
SiteLocation = SiteLocation & "/root"
Dim SiteObj1
Set SiteObj1 = GetObject(SiteLocation)
SiteObj1.authflags=5
SiteObj1.SetInfo
Dim objFSO 'As FileSystemObject
Dim objTextFile 'As Object
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
'write the siteid to a file to use in other scripts
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.CreateTextFile("siteid.txt", True)
objTextFile.Write (SiteId)
objTextFile.Close
End if
End if
Next
Related
I have a code that creates new MS Access Databases. I'd like to add reference libraries to these newly created MS Access Databases.
Here is the code that I wrote but is not working:
Sub makeDb(fl As String)
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
'check if the file already exists
If fs.FileExists(fl) = False Then
'create new ms access database
Dim accessApp As Access.Application
Set accessApp = New Access.Application
accessApp.DBEngine.CreateDatabase fl, dbLangGeneral
'loop through all references in current database and add them to the newly created dbs
Dim cur_vbProj As VBIDE.VBProject: Set cur_vbProj = Application.VBE.VBProjects(1)
Dim cur_vbRefs As VBIDE.References: Set cur_vbRefs = cur_vbProj.References
Dim cur_vbRef As VBIDE.Reference
For Each cur_vbRef In cur_vbRefs
Dim cur_guid As String: cur_guid = cur_vbRef.Guid
Dim cur_major As Long: cur_major = cur_vbRef.Major
Dim cur_minor As Long: cur_minor = cur_vbRef.Minor
'here is the code that doesn't work
Dim vbProj As VBIDE.VBProject: Set vbProj = accessApp.Application.VBE.VBProjects(1)
Dim vbRefs As VBIDE.References: Set vbRefs = vbProj.References
vbRefs.AddFromGuid Guid:=cur_guid, Major:=cur_major, Minor:=cur_minor
Next
accessApp.Quit
Set accessApp = Nothing
End If
End Sub
The line Set vbProj = accessApp.Application.VBE.VBProjects(1) throws Run-Time error '9' Subscript out of range. How should I modify the code? Is it even possible to add references to an outside database?
Following works for me:
Sub makeDb(f1 As String)
Dim accApp As Access.Application
Dim cur_vbRefs As References
Dim cur_vbRef As Reference
If Dir(f1) = "" Then
Access.DBEngine.CreateDatabase f1, dbLangGeneral
Set accApp = New Access.Application
accApp.OpenCurrentDatabase f1
'loop through all references in current database and add them to the newly created dbs
Set cur_vbRefs = Application.References
For Each cur_vbRef In cur_vbRefs
On Error Resume Next
accApp.References.AddFromGuid cur_vbRef.Guid, cur_vbRef.Major, cur_vbRef.Minor
Next
End If
End Sub
Sub Initialize
On Error GoTo e
Dim session As New NotesSession, db As NotesDatabase, view As NotesView
Dim nvec As NotesViewEntryCollection
Dim c As integer
Set db = session.currentdatabase
Set view = db.getView("Locked Out Users")
Set nvec = view.Allentries
c = nvec.count
If c > 0 Then
Call nvec.Removeall(true)
' Send notification
Dim sarr(1) As String
sarr(0) = "john.doe#acme.com"
sarr(1) = "foo#acme.com"
Dim mdoc As NotesDocument, rt As notesrichtextitem
Set mdoc = db.createdocument
mdoc.Form = "Memo"
mdoc.Subject = "Removed " + CStr(c) + " Locked out users on mypage"
Set rt = mdoc.Createrichtextitem("Body")
Call rt.Appendtext("Removed " + CStr(c) + " Locked out users")
Call rt.Addnewline(1)
Call rt.Appendtext("Click to open lockout database")
Call rt.Appenddoclink(db,"Lockout")
Call mdoc.Send(False, sarr)
End If
Exit Sub
e:
Print Error,erl
End Sub
I’m a beginner in Lotus Domino it I have some question , It's possible to change this script to delate only locked users with specified name?
I added something like that:
Dim nam As NotesName
Dim c As integer
Set db = session.currentdatabase
Set nam.OrgUnit1 = (“GD”)
Set view = db.getView("Locked Out Users")
Set nvec.OrgUnit1 = view.Allentries
c = nvec.count
If c > 0 Then
In my case I need delete all group person how has specified dc, for example Robert Kowalski/GD/Company everybody how has in name dc=GD?
There are at least 2 ways to achieve your request.
First you can copy the view "Locked Out Users" and change the selection formula to only include your OU.
The other option is something like
dim doc as notesdocument
dim nextDoc as notesdocument
set doc = view.getfirstdocument()
while not doc is nothing
set nextDoc = view.getnextDocument(doc)
set nam = new notesname(doc.getItemValue("[NAMEITEM]")(0))
if strcompare(nam.orgUnit1,"GD",5)=0 then
call doc.remove(true,false)
end if
set doc = nextDoc
wend
Sub Initialize
On Error GoTo e
Dim session As New NotesSession, db As NotesDatabase, view As NotesView
Dim nvec As NotesViewEntryCollection
Dim c As integer
Set db = session.currentdatabase
dim doc as notesdocument
dim nextDoc as notesdocument
set doc = view.getfirstdocument()
while not doc is nothing
set nextDoc = view.getnextDocument(doc)
set nam = new notesname(doc.getItemValue("[NAMEITEM]")(0))
if strcompare(nam.orgUnit1,"GD",5)=0 then
call doc.remove(true,false)
end if
set doc = nextDoc
wend
Set view = db.getView("Locked Out Users")
Set nvec = view.Allentries
c = nvec.count
If c > 0 Then
Call nvec.Removeall(true)
' Send notification
Dim sarr(1) As String
sarr(0) = "john.doe#acme.com"
sarr(1) = "foo#acme.com"
Dim mdoc As NotesDocument, rt As notesrichtextitem
Set mdoc = db.createdocument
mdoc.Form = "Memo"
mdoc.Subject = "Removed " + CStr(c) + " Locked out users on mypage"
Set rt = mdoc.Createrichtextitem("Body")
Call rt.Appendtext("Removed " + CStr(c) + " Locked out users")
Call rt.Addnewline(1)
Call rt.Appendtext("Click to open lockout database")
Call rt.Appenddoclink(db,"Lockout")
Call mdoc.Send(False, sarr)
End If
Exit Sub
e:
Print Error,erl
End Sub
Thank You #umeli for Yours responce. I think now
it should work.
TortoiseSVN provides a COM interface for retrieving information about a file.
Using VBA, I can get information about a file in the SVN repository by doing this:
Public Function getSvnURL(ByVal fullFilename As String)
Dim oSvn As Object
Set oSvn = CreateObject("SubWCRev.Object")
oSvn.GetWCInfo fullFilename, 1, 1
getSvnURL = oSvn.url
End Function
If I have an SVN revision number however, is there an API I can use to get the files that were part of that commit? Something like:
Public Function getFilesInRevision(revisionNumber As Integer) as Collection
Dim oSvn As Object
Set oSvn = CreateObject("SubWCRev.Object")
oSvn.GetWCInfo revisionNumber
getFilesInRevision= oSvn.fileList
End Function
I ended up using the following method:
Public Function getFilesForRevision(revisionNumber As Long, folder As String) As Collection
Dim command As String
command = "svn log -v -q -r " & revisionNumber & " " & folder
Dim rawText As String
rawText = ShellRun(command)
Dim lines() As String
lines = Split(rawText, vbLf)
Set getFilesForRevision = New Collection
Dim filenameRegex As Object
Set filenameRegex = CreateObject("VBScript.RegExp")
filenameRegex.Pattern = "\s{3}.\s(.*)"
Dim line As Variant
For Each line In lines
If filenameRegex.test(line) Then
getFilesForRevision.Add (filenameRegex.Execute(line).Item(0).submatches(0))
End If
Next line
End Function
Which relies on this method to run the command and store the console output:
'http://stackoverflow.com/questions/2784367/capture-output-value-from-a-shell-command-in-vba
Public Function ShellRun(sCmd As String) As String
'Run a shell command, returning the output as a string'
Dim oShell As Object
Set oShell = CreateObject("WScript.Shell")
'run command'
Dim oExec As Object
Dim oOutput As Object
Set oExec = oShell.Exec(sCmd)
Set oOutput = oExec.StdOut
'handle the results as they are written to and read from the StdOut object'
Dim s As String
Dim sLine As String
While Not oOutput.AtEndOfStream
sLine = oOutput.ReadLine
If sLine <> "" Then s = s & sLine & vbCrLf
Wend
ShellRun = s
End Function
Which can be called like this:
Sub getFilesForRevisionTest()
Dim files As Collection
Set files = getFilesForRevision(111041, "C:\SVN\")
Dim fullFilename As Variant
For Each fullFilename In files
Debug.Print fullFilename
Next fullFilename
End Sub
I have the following code:
Option Compare Database
Private Sub Command27_Click()
Dim fso, f
Set fso = CreateObject("scripting.FileSystemObject")
Set f = fso.OpenTextFile("M:\Instructor Letter Templates (Typical).htm")
InstructorText = f.ReadAll
f.Close
Set f = Nothing
Set fso = Nothing
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sql As String
Dim strWhere As String
Set db = CurrentDb()
sql = "SELECT Classes.ClassID, Grade.GradeID, Instructors.RiosaladoEmail, students.sLastName, students.sFirstName, Grade.Form, Grade.Printout FROM students INNER JOIN (Classes INNER JOIN (Instructors INNER JOIN Grade ON Instructors.InstructorID = Grade.[Instructor]) ON Classes.ClassID = Grade.ClassID) ON students.StudentID = Grade.StudentID WHERE Grade.DateProcessed=Date()"
Set rs = db.OpenRecordset(sql, dbOpenDynaset)
Do Until rs.EOF
Dim Class As String
Dim Grade As String
Dim Email As String
Dim Today As String
Dim sLast As String
Dim sFirst As String
Dim Form As String
Class = rs("ClassID")
Grade = rs("GradeID")
Email = rs("RiosaladoEmail")
sLast = rs("sLastName")
sFirst = rs("sFirstName")
Form = rs("Form")
Const cdoSendUsingPickup = 1
Const cdoSendUsingPort = 2
Const cdoAnonymous = 0
Const cdoBasic = 1
Const cdoNTLM = 2
Set cdomsg = CreateObject("CDO.Message")
cdomsg.Subject = sLast & "," & sFirst & Class & Chr(32) & Form
cdomsg.FROM = "<myemail>"
cdomsg.To = Email
cdomsg.HTMLBody = InstructorText
cdomsg.AddAttachment
cdomsg.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Name or IP of Remote SMTP Server
cdomsg.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
'Type of authentication, NONE, Basic (Base64 encoded), NTLM
cdomsg.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
'Your UserID on the SMTP server
cdomsg.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = "MyEmail"
'Your password on the SMTP server
cdomsg.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "MyPW"
'Server port (typically 25)
cdomsg.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
'Use SSL for the connection (False or True)
cdomsg.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
cdomsg.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
cdomsg.Configuration.Fields.Update
cdomsg.Send
rs.MoveNext
Loop
Set rs = Nothing
Set db = Nothing
End Sub
In the query, the field "Grade.Printout" is an Access attachment field with a file attached to it ... in a table.
I want to use this field with cdomsg.AddAttachment ... I know that if I use "cdomsg.AddAttachment ("")" that I can attach a specific file path ... but I want to use the attachment field within Access.
Or is there a better way to do this? Any suggestions would be awesome, thanks!
The CDO AddAttachment method needs to be given the location of the file to be attached, and it doesn't have any way of recognizing a reference to an Access table/field. Therefore you'll need to save the Access attachment to a temporary location using the SaveToFile method of an Access DAO Field2 object, and then pass the path of that file to the CDO AddAttachment method.
I am trying to update rows of my database through lotusscript. My database connection working well. But the result.update command doesn't work and my rows aren't updated by the query. The problem is in the query result.updaterow because it doesn't make errors anywhere else.
Anyone have a solution to make it work;
Option Public
Option Declare
UseLSX "*LSXODBC"
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim dbcontacts As NotesDatabase
Dim doc As NotesDocument
Dim DocContact As NotesDocument
Dim CandidatView As NotesView
Dim ContactView As NotesView
Dim connection As ODBCConnection
Dim query As ODBCQuery
Dim result As ODBCResultSet
Dim consultantref As String
Set db = session.CurrentDatabase
Set connection = New ODBCConnection
Set dbcontacts= session.GetDatabase("", "names.nsf")
Set query = New ODBCQuery
Set result = New ODBCResultSet
Set query.Connection = connection
Set result.Query = query
On Error Resume Next
Set CandidatView=db.GetView( "Persons" )
Set ContactView=dbcontacts.GetView( "(PersonsTestImport)" )
Call connection.ConnectTo("datasource", "username", "password")
If connection.IsConnected Then
Set doc=CandidatView.GetFirstDocument
CandidatView.AutoUpdate = False
While Not ( doc Is Nothing )
query.SQL="select * from users where id_toucan='"+doc.can_doc_ID(0)+"'"
result.Execute
If result.IsResultSetAvailable Then
Do
result.NextRow
namepers=doc.can_pers(0)
Set DocContact=ContactView.Getdocumentbykey(consultantref)
Call result.SetValue("first_name",DocContact.FirstName(0))
Call result.SetValue("last_name", DocContact.LastName(0))
Call result.SetValue("email", DocContact.MailAddress(0))
result.UpdateRow
Loop Until result.IsEndOfData
End If
Set doc = CandidatView.GetNextDocument( doc )
Wend
Else
MsgBox"Not connected"
End If
result.Close(DB_CLOSE)
connection.Disconnect
End Sub
I tried it with the sql query UPDATE and it's working now :
Option Public
Option Declare
UseLSX "*LSXODBC"
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim dbcontacts As NotesDatabase
Dim doc As NotesDocument
Dim DocContact As NotesDocument
Dim CandidatView As NotesView
Dim ContactView As NotesView
Dim connection As ODBCConnection
Dim query As ODBCQuery
Dim result As ODBCResultSet
Dim consultantref As String
Set db = session.CurrentDatabase
Set connection = New ODBCConnection
Set dbcontacts= session.GetDatabase("", "names.nsf")
Set query = New ODBCQuery
Set result = New ODBCResultSet
Set query.Connection = connection
Set result.Query = query
On Error Resume Next
Set CandidatView=db.GetView( "Persons" )
Set ContactView=dbcontacts.GetView( "(PersonsTestImport)" )
Call connection.ConnectTo("datasource", "username", "password")
If connection.IsConnected Then
Set doc=CandidatView.GetFirstDocument
CandidatView.AutoUpdate = False
While Not ( doc Is Nothing )
namepers=doc.can_pers(0)
Set DocContact=ContactView.Getdocumentbykey(consultantref)
Set DocContact=ContactView.Getdocumentbykey(consultantref)
first_name_ref=DocContact.FirstName(0)
last_name_ref=DocContact.LastName(0)
email_ref=DocContact.MailAddress(0)
query.SQL="UPDATE users SET email_consult_ref='"+email_ref+"', first_name_consult_ref='"+first_name_ref+"',last_name_consult_ref='"+last_name_ref+"' where id_toucan='"+doc.can_doc_ID(0)+"'"
result.Execute
If result.IsResultSetAvailable Then
Do
result.NextRow
Loop Until result.IsEndOfData
End If
Set doc = CandidatView.GetNextDocument( doc )
Wend
End If
result.Close(DB_CLOSE)
connection.Disconnect
End Sub