I am having wcf service which is hosted in IIS how can i consume that service from vb6 application. Provide some set of codes.
Thanks in Advance
George.Santhosh
My vb6 Code is
Function CallService()
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("c:\serviceWsdl.xml", ForReading)
wsdlContract = objFile.ReadAll
objFile.Close
wsdlMonikerString = "service4:address='http://localhost/WCFLIBXML/WCFLibXML.Service1.svc'"
wsdlMonikerString = wsdlMonikerString + ", wsdl='" & wsdlContract & "'"
wsdlMonikerString = wsdlMonikerString + ", binding=wsHttpBinding, bindingNamespace='http://Microsoft.ServiceModel.Samples' "
wsdlMonikerString = wsdlMonikerString + ", contract=WCFLibXML.IService1, contractNamespace='http://Microsoft.ServiceModel.Samples' "
Set wsdlServiceMoniker = GetObject(wsdlMonikerString)
MsgBox "WSDL service moniker: 145 - 76.54 = " & wsdlServiceMoniker.Subtract(145, 76.54)
End Function
I am getting the following error
Run-time error '-2147221020(800401e4)':
Automation error
Invalid syntax
Related
I have a simple vbscript that count the number of files/subfolders in a folder, if the number greater than 5, it will pop up a message to user. I can run this script manually under admin or normal user account, but after I scheduled it in task scheduler as admin, it shows task running, [task started] [action started] [created task process] but it never ends and I never see the message box pops up under user accounts. Is there anything wrong?
Code:
Set filesys = CreateObject("Scripting.FileSystemObject")
Set shell = CreateObject("Shell.Application")
Set RTMFolder = filesys.GetFolder("C:\work\RTM")
Set PMFolder = filesys.GetFolder("C:\work\Powermill")
Set RTMFiles = RTMFolder.Files
Set PMFiles = PMFolder.SubFolders
NumberOfRTM = RTMFiles.Count
NumberofPM = PMFiles.Count
'Wscript.echo NumberOfRTM
Set wshShell = WScript.CreateObject( "WScript.Shell" )
strComputerName = wshShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )
If NumberOfRTM >= 5 Then
msgbox "Dear user on " & strComputerName & vbcrlf & " " & vbcrlf & "There are more than 5 RTM files saved on C:\WORK\RTM folder, Please move them to K drive.", &h51000, "Clean up C:\work\RTM"
shell.Open "C:\WORK\RTM"
End If
If NumberofPM >= 5 Then
msgbox "Dear user on " & strComputerName & vbcrlf & " " & vbcrlf & "There are more than 5 Powermill files saved on C:\WORK\Powermill folder, Please Clean it up.", &h51000, "Clean up C:\work\Powermill"
shell.Open "C:\WORK\Powermill"
End If
'Release memory
Set RTMFolder = Nothing
Set PMFolder = Nothing
Set RTMFiles = Nothing
Set PMFiles = Nothing
Try your program/script to be c:\windows\syswow64\cscript.exe or even c:\windows\system32\cscript.exe and then have the argument be c:\path_to_your_vbs\your.vbs
I am new to coding, scripting, or even for creating macros. I have been trying to reduce the workload given to me by using VBA and for my coworkers who put the enormous time in repetitions trying to achieve the goal given by managers. I want some help from you guys with some guidance. So I am currently making a basic application in excel for my coworker I have created some code of it to work it will take time but I got one idea I don't know whether it is possible or not. I will give him the workbook once the projects complete from then onwards that workbook will be populated by the data etc I want something like an application to have feature built-in workbook like from one week now I get one idea or a feature I want to add in the workbook how to approach this problem?
I want something like applications that have like pop up and it checks the newer version of the workbook and downloads the code or restructure the code without affecting the data in the workbook.
i'm not an expert nor a newbie !
Simple way is
https://www.mrexcel.com/board/threads/use-vba-to-download-a-file.146856/
Public Sub DownloadInternetFile()
'****************************************************************************************************
' This function is will download a new version of the program. The function uses
' the XMLHTTP object to download files directly from HTTP site. The URL to download
' and the file name to save as are parameters passed by the calling procedure.
'****************************************************************************************************
' Version: 1.0
' Last Modified: 2005-06-16
' Written by: ...
'****************************************************************************************************
Dim StatusMsg As String, FileSize As String, LastModified As String
Dim HeaderData As String, StartTime As Date, EndTime As Date, StateTime As Date
Dim BinaryData As Variant, BinaryData1 As Variant, BinaryData2 As Variant
Dim BinaryData3 As Variant, BinaryData4 As Variant
Dim UnformattedData As String, CurrentState As Variant
Dim FileURL As Variant, SaveFileAs As String, i As Integer, tmp As Double
Const adTypeBinary = 1
Const adSaveCreateNotExist = 1
Const adSaveCreateOverWrite = 2
Set WSH = CreateObject("WScript.Shell")
Set HttpObj = CreateObject("Microsoft.XMLHTTP")
Set BinaryStream = CreateObject("ADODB.Stream")
CurrentState = -1
FileURL = "http://home.comcast.net/~davidawitkin/AdbeRdr60_enu_full.exe"
SaveFileAs = WSH.SpecialFolders("Desktop") & "\" & "AdbeRdr60_enu_full.exe"
StartTime = Now()
HttpObj.Open "GET", FileURL, True
HttpObj.Send
CurrentState = HttpObj.ReadyState
Do Until CurrentState = 4
CurrentState = HttpObj.ReadyState
Select Case CurrentState
Case 1
StateTime = Now()
StatusMsg = StatusMsg & vbNewLine & "State 1: " & StateTime & _
"Size: " & Len(HttpObj.ResponseText)
CurrentState = HttpObj.ReadyState
Case 2
StateTime = Now()
StatusMsg = StatusMsg & vbNewLine & "State 2: " & StateTime & _
"Size: " & Len(HttpObj.ResponseText)
CurrentState = HttpObj.ReadyState
Case 3
StateTime = Now()
StatusMsg = StatusMsg & vbNewLine & "State 3: " & StateTime & _
"Size: " & Len(HttpObj.ResponseText)
CurrentState = HttpObj.ReadyState
End Select
CurrentState = HttpObj.ReadyState
Loop
StateTime = Now()
StatusMsg = StatusMsg & vbNewLine & "State 4: " & StateTime & vbNewLine & _
"Size: " & Len(BinaryData)
MsgBox StatusMsg, 64, "State Change Info"
' Load the binary data into a variable.
BinaryData = HttpObj.ResponseBody
' Specify stream type - we want To save binary data.
BinaryStream.Type = adTypeBinary
' Open the stream And write binary data To the object
BinaryStream.Open
BinaryStream.Write BinaryData
' Save binary data To disk
BinaryStream.SaveToFile SaveFileAs, adSaveCreateOverWrite
EndTime = Now()
' Get header data As a string
UnformattedData = HttpObj.GetResponseHeader("Content-Length")
FileSize = FormatNumber(UnformattedData / 1024000, 1, , -1)
LastModified = HttpObj.GetResponseHeader("Last-Modified")
StatusMsg = "File Size: " & FileSize & " Mbytes" & vbNewLine & _
"Last Modified: " & LastModified & vbNewLine & _
"Binary Data Size: " & BinaryStream.Size
MsgBox StatusMsg, 64, "HeaderData"
End Sub
and then run new file with new code struct!
URL shouldn't to be changed ! in same version , but in any version you can set a different update URL .
Or Option 2 is
Create an Option based user form
that can read options from a plain text
and you can download the txt file and so.
An error occurred while using a custom VBScript to create users in active directory users and computers in windows server 2012.
Error Code 8007202f, a Constraint Violation occurred
The .vbs file retrieves data from an Excel file. I used the script to create user accounts once, but when the script was used again for the second time, the error occurred.
Here is the script I used:
'On Error Resume Next
'Make sure to change the OU name as appropriate. Watch about the space after the name.
'Change the domain name also
strOU = "OU=TempOU ,"
strSheet = "C:\staff.xls"
'strPWD = "12345678"
' Bind to Active Directory, Users container.
Set objRootLDAP = GetObject("LDAP://rootDSE")
Set objContainer = GetObject("LDAP://" & strOU & _
objRootLDAP.Get("defaultNamingContext"))
' Open the Excel spreadsheet
Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open(strSheet)
intRow = 2 'Skip row for headings
Do Until objExcel.Cells(intRow,1).Value = ""
strCN = Trim(objExcel.Cells(intRow, 1).Value)
strFirst = Trim(objExcel.Cells(intRow, 2).Value)
strSam = Trim(objExcel.Cells(intRow, 3).Value)
strDscpt = Trim(objExcel.Cells(intRow, 4).Value)
strLast = Trim(objExcel.Cells(intRow, 5).Value)
strpasswd=Trim(objExcel.Cells(intRow, 6).Value)
'strpasswd=""
'Principal Name
strPrin = strSam & "#" & "NSBMTEST.com"
'New Container Name and display
strCNnew = strCN
'Created container name as SMB_
Set objUser = objContainer.Create("User", "cn=" & strCNnew)
objUser.userPrincipalName = strPrin
objUser.sAMAccountName = strSam
objUser.givenName = strFirst
'objUser.sn = strLast
objUser.displayName = strCNnew
objUser.Description = strDscpt
objUser.SetInfo
' enable account with password
objUser.userAccountControl = 512
objUser.pwdLastSet = 0
objUser.SetPassword strPWD
objUser.SetPassword strpasswd
objUser.SetInfo
'Pw set to not expire
'Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
'lngFlag = objUser.userAccountControl
' lngFlag = lngFlag Or ADS_UF_DONT_EXPIRE_PASSWD
'objUser.userAccountControl = lngFlag
'objUser.SetInfo
intRow = intRow + 1
Loop
objExcel.Quit
WScript.Quit
I have a macro that works fine on other machines, especially Excel 2010 on Win XP SP3 at my office. However, trying to run the exact same code on my Win 8.1 laptop with Excel 2013, I keep getting an "Error 70: Permission Denied"
I've researched, the majority of discussions focus on attempting to access open or locked files. In this case, I'm counting files and subfolders.
The complete code is here:
Option Explicit
Private FSO As Object
Private cFiles(1 To 3) As Long
Private cFolders(1 To 3) As Long
Sub Folders()
Dim i As Long
Dim sFolder As String
Dim iStart As Long
Dim iEnd As Long
Dim fOutline As Boolean
cFiles(1) = 0: cFiles(2) = 0: cFiles(3) = 0
cFolders(1) = 0: cFolders(2) = 0: cFolders(3) = 0
Set FSO = CreateObject("SCripting.FileSystemObject")
sFolder = "N:\E-Pros Admin\NEW HUB\Division 4 Order Processing\Contracts\CONTRACTS PRIOR TO 05-07-14\"
SelectFiles sFolder
MsgBox "# of files: " & cFiles(1) & vbNewLine & _
"# of folders with files: " & cFiles(2) & vbNewLine & _
"# of folders with no files " & cFiles(3) & vbNewLine & _
"# of folders: " & cFolders(1) & vbNewLine & _
"# of folders with subfolders: " & cFolders(2) & vbNewLine & _
"# of folders with no subfolders: " & cFolders(3)
Set FSO = Nothing
End Sub
'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Dim oSubFolder As Object
Dim oFolder As Object
If FSO Is Nothing Then
End If
Set oFolder = FSO.GetFolder(sPath)
cFiles(1) = cFiles(1) + oFolder.Files.count
If oFolder.Files.count > 0 Then
cFiles(2) = cFiles(2) + 1
Else
cFiles(3) = cFiles(3) + 1
End If
cFolders(1) = cFolders(1) + 1
If oFolder.SubFolders.count > 0 Then
cFolders(2) = cFolders(2) + 1
For Each oSubFolder In oFolder.SubFolders
SelectFiles oSubFolder.Path
Next
Else
cFolders(3) = cFolders(3) + 1
End If
End Sub
The code that throws the error is in the following function/code:
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Dim oSubFolder As Object
Dim oFolder As Object
If FSO Is Nothing Then
End If
Set oFolder = FSO.GetFolder(sPath)
cFiles(1) = cFiles(1) + oFolder.Files.count **<== This line throws Error 70 Permission Denied**
If oFolder.Files.count > 0 Then
cFiles(2) = cFiles(2) + 1
Else
I have checked all permissions, DCOM both 32 and 64 bit, have all permissions maxed out for Excel (Everyone can access everything, but still no go. Completely frustrated.
Any help would really be appreciated.
Thanks, Jeff
The so called "junction points" NTFS "Symbolic Links" are to blame for this errors.
See: http://support.microsoft.com/kb/930128/en
I tried it with my Windows 7 system. It is not updated from Windows XP. Nevertheless there are such junction points for example "C:\Users\axel\Documents\Eigene Bilder". If the FSO gets such junction point as Folder object, it gets a Folder object with blank Files collection without any methods or properties. Same for the SubFolders collection. But they are not Nothing. They are Objects. If the program tries to access those collections, the Error 70 "Access denied" is thrown.
As a solution you could use On Error Resume Next before access to .Files and .SubFolders with possible such junction points and On Error Goto 0 after the access. But the junction points will not be counted.
Greetings
Axel
I am looking for a way to find the log folder path of a certain website in IIS by its ID name, like: W3SVC1 or any other method, from inside my application. Is this possible? I tried looking up and down google and found nothing. How is this achieved?
The following code works, but only gets all of the application names/ids (like W3SVC/1), i need the actual log file path, and since they can change I don't want to use the static default log file directory as the root on this:
Function ProcessWebSite(ServiceType, SiteNumber)
Set IISWebSite = getObject("IIS://localhost/" & ServiceType & "/" & SiteNumber)
Set IISWebSiteRoot = getObject("IIS://localhost/" & ServiceType & "/" & SiteNumber & "/root")
ProcessWebSite = IISWebSite.ServerComment
Set IISWebSiteRoot = nothing
Set IISWebSite = Nothing
end function
Function ShowSites(ServiceType, ClassName, Title)
Response.write "Web Sites Description=" & "<br>"
Response.write "===============================================================" & "<br>"
Set IISOBJ = getObject("IIS://localhost/" & ServiceType)
for each Web in IISOBJ
if (Web.Class = ClassName) then
Response.write Ucase(ServiceType) & "/" & Web.Name & _
Space(17-(len(Ucase(ServiceType))+1+len(Web.Name))) & " " & _
ProcessWebSite(ServiceType, Web.name) & "<br>"
end if
next
Set IISOBj=Nothing
End function
Call ShowSites("w3svc", "IIsWebServer", "Web")
Function Returnlog(WebSitePath)
Dim statut
Set IISOBJRoot = getObject(webSitePath)
Returnlog = IISOBJRoot.LogFileDirectory
set IISOBJRoot = Nothing
end Function
IIsObjectPath = "IIS://localhost/w3svc"
Set IIsObject = GetObject(IIsObjectPath)
for each obj in IISObject
if (Obj.Class = "IIsWebServer") then
BindingPath = IIsObjectPath & "/" & Obj.Name
Set IIsObjectIP = GetObject(BindingPath)
WScript.Echo IISObjectIP.ServerComment & ": " & Returnlog(IISObjectIP.ADSPath) & vbnewline
'WScript.Echo IISObjectIP.LogType & vbnewline
end if
next