VBForums - ASP, VB Script

VBScript to VB.NET Conversion

Tosaka Kawashita — Mon, 20 May 2013 21:52:03 GMT

Hello. I've been looking online all over for a VBScript to VB.NET converter, but of course, they are incompatible.

Could someone rewrite these three into VB.NET for me, please?

revert_version.vbs

Code:

on error resume next

set fso = createobject("scripting.filesystemobject")

set shell = createobject("shell.application")

revision_file = wscript.arguments.item(0)

revision_folder = fso.getparentfoldername(revision_file)

fso.movefile revision_file , left(revision_file,len(revision_file)-8)&".zip"

set zipfile = shell.namespace(left(revision_file,len(revision_file)-8)&".zip")

set srcfolder = shell.namespace(revision_folder)

for each item in srcfolder.items

if (item.type <> "VERSION File") and (item.name <> fso.getfilename(left(revision_file,len(revision_file)-8)&".zip")) then

if item.isfolder then

fso.deletefolder(item.path)

else

fso.deletefile(item.path)

end if

end if

next

for each item in zipfile.items

srcfolder.copyhere item

next

fso.movefile left(revision_file,len(revision_file)-8)&".zip" , revision_file

create_backup.vbs

Code:

on error resume next

set shell = createobject("shell.application")

set fso = createobject("scripting.filesystemobject")

newfilename = "__BACKUP_"&replace(cstr(date),"/","_")&" "&replace(cstr(time),":","_")

set zipfile = fso.createtextfile(wscript.arguments.item(0)&"\"&newfilename&".zip")

zipfile.write("PK" & chr(5) & chr(6) & string(18,chr(0)))

zipfile.close

set zipfile = shell.namespace(wscript.arguments.item(0)&"\"&newfilename&".zip")

set srcfolder = shell.namespace(wscript.arguments.item(0)&"\")

for each item in srcfolder.items

wscript.sleep 500

if (item.type <> "BACKUP File") and (item.name <> (newfilename&".zip")) then

zipfile.copyhere item

end if

next

' the following loop waits until the script has finished adding files to the zip file

set zipfile2 = fso.getfile(wscript.arguments.item(0)&"\"&newfilename&".zip")

do

zipfile2_size = zipfile2.size

wscript.sleep 100

loop while zipfile2.size > zipfile2_size

wscript.sleep 100

fso.movefile wscript.arguments.item(0)&"\"&newfilename&".zip" , wscript.arguments.item(0)&"\"&newfilename&".backup"

new_revision.vbs

Code:

on error resume next

set shell = createobject("shell.application")

set fso = createobject("scripting.filesystemobject")

newfilename = "__REVISION_"&replace(cstr(date),"/","_")&" "&replace(cstr(time),":","_")

set zipfile = fso.createtextfile(wscript.arguments.item(0)&"\"&newfilename&".zip")

zipfile.write("PK" & chr(5) & chr(6) & string(18,chr(0)))

zipfile.close

set zipfile = shell.namespace(wscript.arguments.item(0)&"\"&newfilename&".zip")

set srcfolder = shell.namespace(wscript.arguments.item(0)&"\")

set zipfile2 = fso.getfile(wscript.arguments.item(0)&"\"&newfilename&".zip")

wscript.sleep 500

for each item in srcfolder.items

wscript.echo item.name

wscript.sleep 500

if (item.type <> "VERSION File") and (item.type <> "Compressed (zipped) Folder" ) then

zipfile.copyhere item

do

zipfile2_size = zipfile2.size

wscript.sleep 100

loop while zipfile2.size > zipfile2_size

end if

next

' the following loop waits until the script has finished adding files to the zip file

wscript.sleep 100

fso.movefile wscript.arguments.item(0)&"\"&newfilename&".zip" , wscript.arguments.item(0)&"\"&newfilename&".version"

Thanks.

I couldn't attach them, because they were not blocked by the filter.

ASP to VB conversion for a web method

rkear89 — Fri, 17 May 2013 16:41:19 GMT

I need the following code converted to VB to work in a web method I am creating. I had tried a few different things with no success. Hoping someone might be able to help me out. Thanks!

strSQL = "SELECT @@IDENTITY AS recid"
Set rsTemp = ocnComp.Execute(strSQL)
If Not rsTemp.EOF Then
strRecid = Trim(rsTemp("recid"))

i = 0
Do While Len(arrParts(i, 0)) > 0

' Create the INSERT statement for the 'detail' table.
strSQL = "INSERT INTO seqexp_detail (recid, custpart, qty, comment, who, active) " & _
"VALUES (" & strRecid & ", '" & arrParts(i, 0) & "', '" & arrParts(i, 1) & "', '" & arrParts(i, 2) & "', '" & arrParts(i, 3) & "', 1)"
'ocnComp.Execute(strSQL)
i = i + 1

Loop

Using LDAP to move OU's in ADSI

gslomka — Fri, 17 May 2013 13:07:28 GMT

Hello there.

I have an ADSI server, and i have the following structure on it:

OU Laboratory
OU Blocked
OU PC_1
OU PC_2
OU NOTBLOCKED
OU PC_3
OU PC_4

The computers are OUs, with Computers inside OUS (in fact the PC represents a laboratory room in our university).

So i have an ASP function, that will recieve a BLOCKED pc name, and move it to the NOTBLOCKED OU, but i am not managing to do so.

This is the far i could go:

Code:



                Set ou = dso.OpenDSObject("LDAP://IP/ou=" & pcName & ",ou=Blocked,ou=Labs,dc=acd,dc=puc-campinas,dc=edu,dc=br", "user", "pass", 1)

                ou.MoveHere "LDAP://IP/ou=NotBlocked,ou=Labs,dc=acd,dc=puc-campinas,dc=edu,dc=br", "ou=" & pcName

It doesnt work :( Im not sure how could i make this happen.

Would really apreciate any help ! Thanks alot for the time !

To abruptly end a vb script when user clicks on "Esc" button!!

Raj_123 — Tue, 14 May 2013 18:41:24 GMT

Here is my code written:-

Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run " "
WScript.Sleep 5000
for i=1 to 20
WshShell.SendKeys "^{HOME}"
WshShell.SendKeys "{END}"
WScript.Sleep 50
WshShell.SendKeys " or "
WScript.Sleep 50
WshShell.SendKeys "{DELETE}"
WshShell.SendKeys "{END}"
next

Result of this code basically add's "or" onto any active window! This was written to help me in adding the text "or" in between two values. I run this code and place a notepad as active window which has values. but if i click and open any other window, this code continues untill " i = 20 " but i have to exit from this code if user("I") clicks on "Esc" button. Can somebody provide me solution to it.
I know there is wshShell.Quit....and i truely dont know how to use it!!

Delete a file with a given extension

thamoomin81 — Tue, 14 May 2013 10:36:08 GMT

Hi All,

Wondering if anyone can help, I'm attempting to delete a .ost file from a users roaming profile, I'm using the following code:

Dim strComputer, oWSH, oWMI, oFSO, AppDataFolder

strComputer = "."
Set oWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set oWSH = CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")
AppDataFolder = oWSH.ExpandEnvironmentStrings("%appdata%")

For Each file As String In IO.Directory.GetFiles(AppDataFolder & "\Thinstall\Microsoft Standard 2010 KMS\%Local AppData%\Microsoft\Outlook","*.ost")
IO.File.Delete(file)
Next

I keep getting "Expected In" error message on line 9 char 15. Any idea why? Sorry but I literally do no VB coding so am a bit lost.

Regards,
Ross

function in visual basic

kaczak1108 — Thu, 09 May 2013 08:11:50 GMT

Hi, i wrote a procedure and function. I transfer this function into procedure. If i try execute procedure i have an error: argument not optional on this function.

Code:

Public Function inserthgbstshow(level As String, relation As Long) As String



    Dim funObjid As Long

    funObjid_show = pobierz_objid(ptype_id_inserthgbstshow)

    

    conn.Execute "insert into table_hgbst_show(OBJID, LAST_MOD_TIME, TITLE, DEV_VAL, DEV, CHLD_PRNT2HGBST_SHOW) values (" + funObjid_show + ", to date(1753-01-01), '" + level + "', 0, "", " + relation + ")"

    inserthgbstshow = funObjid_show

End Function

Code:

Sub Zaimportuj()

    Dim objid_show_level_1 As Long

    Dim objid_show_level_2 As Long

    Dim objid_show_level_3 As Long

    Dim objid_show_level_4 As Long

    Dim objid_show_level_5 As Long

    Dim last_name_level_1 As String

    Dim last_name_level_2 As String

    Dim last_name_level_3 As String

    Dim last_name_level_4 As String

    Dim last_name_level_5 As String

    

    objid_show_level_1 = pobierz_list

    

    delete_dane

    

    last_name_level_1 = ""

    last_name_level_2 = ""

    last_name_level_3 = ""

    last_name_level_4 = ""

    last_name_level_5 = ""

    

    Dim c As Object

    

With Sheets(1).Range("A:A")

Set c = .Find(what:="*", LookIn:=xlValues, LookAt:=xlPart, searchorder:=xlByRows, searchdirection:=xlPrevious)

End With

MsgBox ("Ostatni zapisany wiersz to: " & c.Row)

Dim x As Integer

x = 3

For x = 3 To c.Row

    If Range("B" + CStr(x)) <> "" Then

        

        inserthgbstelement

        inserthgbstelm0hgbstshow1

        

    If Range("D" + CStr(x)) <> "" Then

        If last_name_level_1 <> Range("A" + CStr(x)) Then

            objid_show_level_2 = inserthgbstshow

        End If

        inserthgbstelement

        inserthgbstelm0hgbstshow1

    

    If Range("F" + CStr(x)) <> "" Then

        If last_name_level_2 <> Range("C" + CStr(x)) Then

            objid_show_level_3 = inserthgbstshow

        End If

        inserthgbstelement

        inserthgbstelm0hgbstshow1

    

    If Range("H" + CStr(x)) <> "" Then

        If last_name_level_3 <> Range("E" + CStr(x)) Then

            objid_show_level_4 = inserthgbstshow

        End If

        inserthgbstelement

        inserthgbstelm0hgbstshow1

    

    If Range("J" + CStr(x)) <> "" Then

        If last_name_level_4 <> Range("G" + CStr(x)) Then

            objid_show_level_5 = inserthgbstshow

        End If

        inserthgbstelement

        inserthgbstelm0hgbstshow1

                

                End If

             End If

        End If

    End If

    

    last_name_level_1 = Range("A" + CStr(x))

    last_name_level_2 = Range("C" + CStr(x))

    last_name_level_3 = Range("E" + CStr(x))

    last_name_level_4 = Range("G" + CStr(x))

    last_name_level_5 = Range("I" + CStr(x))

End If

Next x

End Sub

Object not in collection

dave64leo — Wed, 08 May 2013 16:47:24 GMT

Hello,

I am having a similar error and would like to ask why the script abandons and returns "Object not in collection"
It's also writing out a text file.

Code:

str_boxname = WScript.Arguments( 0 )



const HKEY_LOCAL_MACHINE = &H80000002

DIM var_IPS

DIM var_Domain

DIM var_SERVERNAME

DIM var_VERSION

DIM var_OS

DIM var_OSVersion

DIM var_OSSP

DIM var_FDQN

DIM var_InstanceName

DIM var_port

DIM var_connection

DIM var_isCluster



var_SERVERNAME         = f_servername(str_boxname)

var_Domain                 = f_DOMAIN(var_SERVERNAME)

var_OS                         = f_OS(var_SERVERNAME)

var_OSVersion   = f_OSVersion(var_SERVERNAME)

var_OSSP        = f_OSSP(var_SERVERNAME)

var_IPS                 = f_IPS(var_SERVERNAME)

var_FDQN        = f_fdqn(var_SERVERNAME)

var_CLUSTER     = f_CLUSTER(var_SERVERNAME)

OutputFile="c:\temp\" & "EPinventory." & var_SERVERNAME 

Set oFSO = CreateObject("Scripting.FilesyStemObject")

Set ofile = ofso.createTextFile(OutputFile, True)





Set StdOut = WScript.StdOut

Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & str_boxname & "\root\default:StdRegProv")

strKeyPath   = "SOFTWARE\Microsoft\Microsoft SQL Server"

strValueName = "InstalledInstances"

oReg.CheckAccess HKEY_LOCAL_MACHINE, strKeyPath, KEY_QUERY_VALUE, bHasAccessRight

If bHasAccessRight = True Then

        ofile.writeline CHR(34)&"DBTYPE"&CHR(34)&"|"&CHR(34)&"DBNAME"&CHR(34)&"|"&CHR(34)&"VERSION"&CHR(34)&"|"&CHR(34)&"INSTANCENAME"&CHR(34)&"|"&CHR(34)&"SERVERNAME"&CHR(34)&"|"&CHR(34)&"INSTANCEIPS"&CHR(34)&"|"&CHR(34)&"PORT"&CHR(34)&"|"&CHR(34)&"DOMAIN"&CHR(34)&"|"&CHR(34)&"OS"&CHR(34)&"|"&CHR(34)&"OSVERSION"&CHR(34)&"|"&CHR(34)&"OSPATCHLEVEL"&CHR(34)&"|"&CHR(34)&"FDQN"&CHR(34)&"|"&CHR(34)&"IPS"&CHR(34)&"|"&CHR(34)&"CLUSTERINFO" &CHR(34) 



        oReg.GetMultiStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,arrValues



        For Each RegInstanceName In arrValues

            var_InstanceName = f_Instance(var_SERVERNAME,RegInstanceName)

            var_Port = f_port(var_SERVERNAME, RegInstanceName )

            var_Connection = f_connection(var_SERVERNAME,RegInstanceName )



                Set oServer = CreateObject("SQLDMO.SQLServer")

                oServer.LoginSecure = True

                if var_iscluster = 1 then

                        oServer.Connect var_Connection & "," & var_port

                else

                        oServer.Connect var_Connection

                        var_CLUSTER = "no cluster info found"

                end if

                var_version = mid(oServer.VersionString,29,10)        

        

                

                For nDatabase = 1 to oServer.Databases.Count

                    ofile.writeline CHR(34) & "MSSQLSRV" & CHR(34) & "|" _ 

                    & CHR(34) & mid(Ucase(oServer.Databases(nDatabase).Name),1,32) & CHR(34) & "|" _         

                    & CHR(34) & var_version      & CHR(34) & "|" _        

                    & CHR(34) & Ucase(var_InstanceName) & CHR(34) & "|" _        

                    & CHR(34) & Ucase(var_SERVERNAME)   & CHR(34) & "|" _         

                    & CHR(34) & "*"   & CHR(34)    & "|" _                                                

                    & CHR(34) & var_Port & CHR(34) & "|" _

                    & CHR(34) & Ucase(var_Domain) & CHR(34) & "|" _                                        

                    & CHR(34) & Ucase(var_OS) & CHR(34) & "|" _                                        

                    & CHR(34) & var_OSVersion & CHR(34) & "|" _                                        

                    & CHR(34) & Ucase(var_OSSP) & CHR(34) & "|" _                                        

                    & CHR(34) & Ucase(var_FDQN) & CHR(34) & "|" _                                        

                    & CHR(34) & mid(var_IPS,1,128) & CHR(34) & "|" _        

                        & CHR(34) & var_CLUSTER & CHR(34)                                         

                    

                Next 

            Set oServer = Nothing                           

        Next

Else

        ofile.writeline "NO_INSTANCE_FOUND"        

End If   



Set oFSO = Nothing



'---------------------------------------------------------------------------------------------------------------------

function f_Instance(strComputer, Installed_Instance)

        Const KEY_QUERY_VALUE = &H0001

        Const HKEY_LOCAL_MACHINE = &H80000002

        if Installed_Instance = "MSSQLSERVER" then

               var_InstanceName = strComputer

                var_isCluster = 0

    else

                Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")

                strKeyPath = "SOFTWARE\MICROSOFT\Microsoft SQL Server\" & Installed_Instance & "\Cluster"

                oReg.CheckAccess HKEY_LOCAL_MACHINE, strKeyPath, KEY_QUERY_VALUE,bHasAccessRight

                If bHasAccessRight = True Then

                    oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, "ClusterName", strValue

                    var_InstanceName = strValue & "\" & Installed_Instance

                    var_isCluster = 1

                Else

                    var_InstanceName = strComputer & "\" & Installed_Instance

                    var_isCluster = 0

                End If   

   end if

   f_Instance = var_InstanceName

end function

'---------------------------------------------------------------------------------------------------------------------

'IPS

function f_IPS (strComputer)

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 

Set colItems = objWMIService.ExecQuery( _

    "SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True",,48) 

For Each objItem in colItems 

    If isNull(objItem.IPAddress) or trim(Join(objItem.IPAddress)) = "" or trim(Join(objItem.IPAddress)) = "0.0.0.0" Then

        var_IPS = var_IPS

    Else

        var_IPS = var_IPS & Join(objItem.IPAddress) & ","

    End If

        

Next

    f_IPS = mid(var_IPS,1,len(var_IPS)-1)

end function



'---------------------------------------------------------------------------------------------------------------------

'RETURNS FDQN

function f_FDQN (strComputer)

        Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 

        Set colItems = objWMIService.ExecQuery( _

            "SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True ",,48) 

        For Each objItem in colItems

            if trim(objItem.DNSHostName) <> "" then 

                    f_FDQN = objItem.DNSHostName

            end if

        Next

end function



'---------------------------------------------------------------------------------------------------------------------

'RETURNS THE DOMAIN

function f_DOMAIN (strComputer)

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 

Set colItems = objWMIService.ExecQuery( _

    "SELECT * FROM Win32_ComputerSystem",,48) 

For Each objItem in colItems 

    f_DOMAIN = objItem.Domain

Next

end function



'---------------------------------------------------------------------------------------------------------------------

'Returns the Operating System 

function f_OS(strcomputer)

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 

Set colItems = objWMIService.ExecQuery( _

    "SELECT * FROM Win32_OperatingSystem",,48) 

For Each objItem in colItems 

    f_OS = objItem.Caption

Next

end function



'---------------------------------------------------------------------------------------------------------------------

'Returns the OS Version

function f_OSVersion(strcomputer)

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 

Set colItems = objWMIService.ExecQuery( _

    "SELECT * FROM Win32_OperatingSystem",,48) 

For Each objItem in colItems 

    f_OSVersion = objItem.Version

Next

end function

'---------------------------------------------------------------------------------------------------------------------

function f_OSSP(strcomputer)

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 

Set colItems = objWMIService.ExecQuery( _

    "SELECT * FROM Win32_OperatingSystem",,48) 

For Each objItem in colItems 

    f_OSSP = objItem.CSDVersion

Next

end function

'---------------------------------------------------------------------------------------------------------------------

'RETURNS THE SERVERNAME

function f_servername(strComputer)

        Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 

        Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem",,48) 

        For Each objItem in colItems 

            f_servername = objItem.Name

        Next

end function

'---------------------------------------------------------------------------------------------------------------------

'RETURNS THE CLUSTER NAME

function f_CLUSTER(strComputer)

        f_CLUSTER = ""

end function

'---------------------------------------------------------------------------------------------------------------------

'CONNECTION STRING 

function f_connection(strComputer, par_InstanceIp)

        Const KEY_QUERY_VALUE = &H0001

        Const HKEY_LOCAL_MACHINE = &H80000002

        var_connection = ""        



        if par_InstanceIp = "MSSQLSERVER" then

               var_connection = strComputer

    else

            Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")

            strKeyPath = "SOFTWARE\MICROSOFT\Microsoft SQL Server\" & par_InstanceIp & "\Cluster"

            oReg.CheckAccess HKEY_LOCAL_MACHINE, strKeyPath, KEY_QUERY_VALUE,bHasAccessRight

            If bHasAccessRight = True Then

               f_instanceIp strComputer, par_instanceIp, var_connection

            Else

                   var_connection = strComputer & "\" & par_InstanceIp

            End If   

   end if



   f_connection = var_connection

end function

'---------------------------------------------------------------------------------------------------------------------



'RETURNS THE PORT NUMBER

function f_port(strComputer,sInstance)

Const HKEY_LOCAL_MACHINE         = &H80000002



        if sInstance = "MSSQLSERVER" THEN

            sComputer = strComputer

        sKey                 = "SOFTWARE\MICROSOFT\MSSQLServer\MSSQLServer\Supersocketnetlib\Tcp"



        else

            sComputer = strComputer

        instance  = sInstance

        sKey      = "SOFTWARE\MICROSOFT\Microsoft SQL Server\"+instance+"\MSSQLServer\Supersocketnetlib\Tcp"

    end if



sMethod                = "GetStringValue"

hTree                = HKEY_LOCAL_MACHINE

sValue                = "TcpPort"

Set oRegistry         = GetObject("winmgmts:{impersonationLevel=impersonate}//"&sComputer&"/root/default:StdRegProv")

Set oMethod             = oRegistry.Methods_(sMethod)

Set oInParam         = oMethod.inParameters.SpawnInstance_()

oInParam.hDefKey = hTree

oInParam.sSubKeyName = sKey

oInParam.sValueName  = sValue

Set oOutParam        = oRegistry.ExecMethod_(sMethod, oInParam)

f_port = Cstr(oOutParam.Properties_("sValue"))

end function



'---------------------------------------------------------------------------------------------------------------------





function F_InstanceIP(strComputer, Installed_Instance, var_connection)

        Const KEY_QUERY_VALUE = &H0001

        Const HKEY_LOCAL_MACHINE = &H80000002

        var_connection = ""        



   Set oRegIp=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")

   strKeyPathIp = "SOFTWARE\Microsoft\Microsoft SQL Server\" & Installed_Instance & "\Cluster" 

   oRegIp.GetMultiStringValue HKEY_LOCAL_MACHINE, strKeyPathIp, "ClusterIpAddr", IParrValues



   For Each strValue In IParrValues

       var_connection = var_connection & strvalue

   Next

   set oRegIp = nothing

   f_instanceip = var_connection



end function

New to VB and need a professionals assistance, please

MemetoMori — Fri, 03 May 2013 22:02:08 GMT

Alright, I'll start at the beginning.

I work for a small company, that uses software that is very poorly developed. I'm attempting to improve the workflow and capabilities of the system via VBS (and any other languages needed). I realize I stated I'm new, that however does not mean I do not know anything at all. I learn almost immediately and have an immense skill to understand anything I'm shown. I need someone to collaborate with me, essentially pointing out where I'm going wrong and where I can improve. If it seems like a tall order, let me say I'm willing to even pay for the help I recieve.

A little background:

I'm a Trumpf500 operator that is attempting to learn programming on the side. I have a decent knowledge of the ins and outs of programming. I had written a proof-of-concept script and a fellow worker had witnessed me using it. One conversation led to another, which led to speaking with our IT Devs, and then the main supervisor. After all the discussions I was given 1-2 months to come up with a working DEMO, not fully fleshed out program or anything too big, just a DEMO. Something that shows my idea and does what it needs to do.

The concept:

There is a program titled: ABC_Desktop we use to log our work. This software is slow, outdated (function wise not code), and open to errors as it relies solely on user input. I'm wanting to use VBScript, Html, xhtml, etc. to create a kind of "add-on" to the program. Something that runs alongside the program, essentially automating data input and helping to eliminate errors by reducing user input.

I suppose you could say it would function as a virtual peripheral. Why am I attempting this when the company could spend money on other software or developers? Well, firstly because I'm passionate about computer programming, and secondly I am being offered a promotion and a raise if i can accomplish this goal.

So, is there anyone here that can/will help me?

weird characters showing up in html

lleemon — Fri, 03 May 2013 14:12:13 GMT

I have a project that gets input from an xml file that we extract information from select nodes.

One of the does we take the info and just output in a

 tag since it's already formated from source.



We started seeing all these B's in the output so I ran a loop through all the characters and display the ascii value to see what it is and this is what I get in return.



How I get value:


	Code:
	
For x=1 To Len(str)

        result = result & Mid(str, x, 1) & "(" & Asc(Mid(str, x, 1)) & ")"

Next
Result for the character in question:

В (-15712)



Any ideas how I can strip these out?



Thanks.

assigning some elements in an array to another array... Please Help

brtm5 — Thu, 02 May 2013 19:32:44 GMT

I'm hoping this is a stupid question that can be answered rather quickly and easily.

So here what I'm trying to do. I want to take a 1 dimensional array that is already full and pass it through a for loop and when ever there is a match to my if statement.
It will copy that element out of the array and put it in a new array.

Here is a example of my code:

Public GlobalArray() As String

Dim aryText() As String
aryText = Inputfile <----- This is where the live rile was passed to the array

Dim newstr_count As Integer = UBound(aryText)

For z = 0 To newstr_count - 1

If aryText(z).Trim = "copy I'm looking to extract from the array"

GlobalArray = (aryText(z), z) '<------- Here is where I can't figure out how to pass the elements I want to keep to another array

z = z + 1
End if

next z

Thank you in advance for your help!
Chris

[RESOLVED] visual basic script

kaczak1108 — Tue, 30 Apr 2013 12:36:01 GMT

Hi, can somone help me? I have script and i dont know what is wrong:

Function LastRow()
Dim c As Object
With Sheets(1).Range("A:A")
Set c = .Find(What:="*", LookIn:=xlValues, Lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlPrevious)
End With
LastRow = (c.Row)
End Function

Function inserthgbstelement(title, status, rank)
Dim funObjid As Long
objName = "hgbst_elm"
funObjid = getNextObjid(objName)

conn.Execute "insert into table_hgbst_elm(objid, TITLE, S_TITLE, RANK, STATE, DEV, INTVAL) values (funObjid, title, Upper(title), rank, status, "",0)"
inserthgbstelement = funObjid
End Function

Sub Przeszukanie_po_wierszu()

Dim c As Object
Dim x As Integer

With Sheets(1).Range("A:A")
Set c = .Find(What:="*", LookIn:=xlValues, Lookat:=xlPart, searchorder:=xlByColumns, searchdirection:=xlPrevious)
For x = 3 To LastRow
y = inserthgbstelement(Sheets(1).Range("A" + x), Sheets(1).Range("B" + x), x - 3)
Next x
End With
End Sub

Error: 13 type mismatch
if i click on debyg show me line y = inserthgbstelement(Sheets(1).Range("A" + x), Sheets(1).Range("B" + x), x - 3)

Detect Table Overlap

drag0n_45 — Sat, 27 Apr 2013 02:12:19 GMT

Hey there,
I'm writing an app that automatically creates a PivotTable.

I've got everything working, except that I want the PivotTables to all appear on the same sheet. Often, users will be performing actions that cause the pivottables' row count to go up and down. I've been asked to make the PivotTables have a 2-row buffer between them. I just need a way to detect if a PivotTable has overlapped another. I've got the code working that moves them up and down by row and column number, or by a difference (i.e. movePivotTableDownBy(2).).
Ideally, there would be an Excel Overlap function that would tell my how much the overlap was so I could move the remaining tables to where they need to be.

As this sheet evolves, I'd like to take into account having more than three PivotTables. Right now I'm at three.

So it would look something like this, I'd think:

Code:

For each pt in pivottables

     get the top and the bottom

     is there already (a table with bottom>pt.top) OR (a table with top
        if so, move pt.(top or bottom) +- (the table with bottom/top) +- 2 

Next x

Any ideas on the data structure for that? I've thought of some kind of variant dictionary, but I'm having a hard time seeing beyond a linear iteration. I'm thinking some kind of hash table, but the problem remains - what do I do to detect if there is a "table collision" without iterating through each entry in a collection, array, etc. and then back through it with each new entry. Some kind of insertion sort on the tops and iteration through the bottoms maybe? Even that seems too complicated.

Anyone got anything?

Empty Reg MultiString

William_D — Thu, 25 Apr 2013 19:55:28 GMT

So, I want to check a REG_MULTI_SZ in a key and if it is empty then do something. However, my script keeps reporting that it contains data when it does not. Whats wrong?

Const HKEY_LOCAL_MACHINE = &H80000002

strComputer = "."
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")

strKeyPath = "SYSTEM\CurrentControlSet\Control\Print\Environments\Windows x64\Drivers\Version-3\HP Universal Printing PCL 5 (v5.4)"
strValueName = "Dependent Files"
objRegistry.GetMultiStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue,arrValues

If IsNull(arrValues) Then
Wscript.Echo "Empty."
Else
Wscript.Echo "The value contains data."
End If