I have solver vba code working fine on Windows (Excel 2013), but there are some problems on macOS with Excel 2011. Here is a code :
SolverReset
SolverAdd CellRef:="$CB$2:$CB$" & LastRow, Relation:=5, FormulaText:="binary"
SolverAdd CellRef:="$CA$3", Relation:=1, FormulaText:="100000"
SolverAdd CellRef:="$CA$10", Relation:=2, FormulaText:="8"
SolverAdd CellRef:="$CA$7", Relation:=3, FormulaText:="3"
SolverAdd CellRef:="$CA$8", Relation:=3, FormulaText:="3"
SolverAdd CellRef:="$CA$9", Relation:=2, FormulaText:="=1"
SolverOptions MaxTime:=100, Iterations:=100, precision:=0.000001, Convergence:= _
0.0001, StepThru:=False, Scaling:=False, AssumeNonNeg:=True, Derivatives:=1
SolverOptions PopulationSize:=100, RandomSeed:=0, MutationRate:=0.075, Multistart _
:=False, RequireBounds:=True, MaxSubproblems:=0, MaxIntegerSols:=0, _
IntTolerance:=0, SolveWithout:=False, MaxTimeNoImp:=30
SolverOk SetCell:="$CA$4", MaxMinVal:=1, ValueOf:=0, ByChange:="$CB$2:$CB$" & LastRow,
_ Engine:=2, EngineDesc:="Simplex LP"
SolverSolve
Problem is that following conditions are missing from solver after applying above code :
SolverAdd CellRef:="$CB$2:$CB$" & LastRow, Relation:=5, FormulaText:="binary"
SolverOk SetCell:="$CA$4", MaxMinVal:=1, ValueOf:=0, ByChange:="$CB$2:$CB$" & LastRow,
_ Engine:=2, EngineDesc:="Simplex LP"
One interesting thing is that only SetCell and ByChange is not set up from second condition, but engine type "Simplex LP" is fine.
I got the code from by recording macro which I setted up manually, so there should not be any problems.
I managed to solve it after a lot of wasted time. It seems that there is a problem with "_" characted in :
SolverOk SetCell:="$CA$4", MaxMinVal:=1, ValueOf:=0, ByChange:="$CB$2:$CB$" & LastRow, _
Engine:=2, EngineDesc:="Simplex LP"
I solved it on following way :
SolverOk SetCell:="$CA$4", MaxMinVal:=1, ValueOf:=0, ByChange:="$CB$2:$CB$" & LastRow
SolverOk SetCell:="$CA$4", MaxMinVal:=1, ValueOf:=0, ByChange:="$CB$2:$CB$" & LastRow, _
Engine:=2, EngineDesc:="Simplex LP"
Related
Is it possible to do MDX queries using VBScript? I have successfully done SQL queries via VBScript, any idea on how to approach MDX queries?
Currently I use a connection string like the following:
strConn = "Driver={SQL Server};" & _
"Server=10.0.0.1;" & _
"Address=10.0.0.1,1433;" & _
"Network=DBMSSOCN;" & _
"Database=databasename;" & _
"UID=user;" & _
"PWD=password;"
What would I have to change it to to get it to work?
I think something like the following:
strConn = _
"Provider=MSOLAP.6;" & _
"Data Source=imxxxxxx;" & _ '<<<name of your server here
"Initial Catalog=AdventureWorksDW2012Multidimensional-EE;" & _ '<<<name of your Adv Wrks db here
"Integrated Security=SSPI"
Here is an example of using it against some mdx:
Dim pubConn As ADODB.Connection
Set pubConn = New ADODB.Connection
pubConn.CommandTimeout = 0
pubConn.Open strConn
Dim cs As ADOMD.Cellset
Set cs = New ADOMD.Cellset
Dim myMdx As String
myMdx = _
" SELECT" & _
" NON EMPTY" & _
" [Customer].[Customer Geography].[State-Province].&[AB]&[CA] ON 0," & _
" NON EMPTY" & _
" [Measures].[Internet Sales Amount] ON 1" & _
" FROM [Adventure Works];"
cs.Open myMdx, pubConn
The above is from my answer (in vba) here: VBA Reptitive MDX query to Analysis Services
I have created a macro to export my sheet as a PDF however some users in the company use Mac OS. When these users attempt to save, it gives them an error. How do I allow both Win and Mac users to use the same PDF export?
Here is my current code:
Sub CreatePDF()
Dim wksSheet As Worksheet
Set wksSheet = ActiveSheet
wksSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & Range("exportName"), Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End Sub
VBA has Application.PathSeparator as well.
http://msdn.microsoft.com/en-us/library/office/ff820973%28v=office.15%29.aspx
I was unable to find the answer to this on SO, but came across this workaround to share:
Sub CreatePDF()
Dim wksSheet As Worksheet
Dim TheOS As String
TheOS = Application.OperatingSystem
If InStr(1, TheOS, "Windows") > 0 Then
Set wksSheet = ActiveSheet
wksSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & Range("exportName"), Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Exit Sub
Else
Set wksSheet = ActiveSheet
wksSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & ":" & Range("exportName"), Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Exit Sub
End If
End Sub
I want to assess the memory and other details of computers connected to my domain. What I am doing is writing the computer name in a text file, one per line. the Script will read the file (hostname) one by one, gather the information, and write it to a file. This is working fine.
Problem is that if one computer is not available then it's making problems. For example, if first host name is available and second is not available, then it keeps showing the same information repeatedly.
INPUT_FILE_NAME = "D:\tmp\Computer.txt"
Const FOR_READING = 1
Const HKEY_LOCAL_MACHINE = &H80000002
strRegKey = "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(INPUT_FILE_NAME, FOR_READING)
strComputers = objFile.ReadAll
objFile.Close
arrComputers = Split(strComputers, vbCrLf)
For Each strComputer In arrComputers
On Error Resume Next
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!" & _
"//./root/default:StdRegProv")
objReg.GetStringValue HKEY_LOCAL_MACHINE, strRegKey, "Hostname", strHostname
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colPageFiles = objWMIService.ExecQuery _
("Select * from Win32_PageFileUsage")
For each objPageFile in colPageFiles
Wscript.Echo "Host Name: " & strHostName, _
"AllocatedBaseSize: "& vbTab & objPageFile.AllocatedBaseSize, _
"CurrentUsage: "& vbTab & objPageFile.CurrentUsage, _
"Description: "& vbTab & objPageFile.Description, _
"InstallDate: "& vbTab & objPageFile.InstallDate, _
"Name: " & vbTab & objPageFile.Name, _
"PeakUsage: " & vbTab & objPageFile.PeakUsage
Next
Next
When GetObject() fails, the variable objWMIService retains its previous value, so you're reporting the same host over and over again, until either GetObject() can connect to a host or the loop terminates. Change this:
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colPageFiles = objWMIService.ExecQuery _
("Select * from Win32_PageFileUsage")
For each objPageFile in colPageFiles
Wscript.Echo "Host Name: " & strHostName, _
"AllocatedBaseSize: "& vbTab & objPageFile.AllocatedBaseSize, _
"CurrentUsage: "& vbTab & objPageFile.CurrentUsage, _
"Description: "& vbTab & objPageFile.Description, _
"InstallDate: "& vbTab & objPageFile.InstallDate, _
"Name: " & vbTab & objPageFile.Name, _
"PeakUsage: " & vbTab & objPageFile.PeakUsage
Next
into this:
Set objWMIService = Nothing
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
If Not objWMIService Is Nothing Then
Set colPageFiles = objWMIService.ExecQuery _
("Select * from Win32_PageFileUsage")
For each objPageFile in colPageFiles
Wscript.Echo "Host Name: " & strHostName, _
"AllocatedBaseSize: "& vbTab & objPageFile.AllocatedBaseSize, _
"CurrentUsage: "& vbTab & objPageFile.CurrentUsage, _
"Description: "& vbTab & objPageFile.Description, _
"InstallDate: "& vbTab & objPageFile.InstallDate, _
"Name: " & vbTab & objPageFile.Name, _
"PeakUsage: " & vbTab & objPageFile.PeakUsage
Next
Else
WScript.Echo strComputer & " unavailable."
End If
and the problem will disappear.
On a different note, the first 2 lines in the outer loop will always retrieve the hostname of your local computer:
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!" & _
"//./root/default:StdRegProv")
objReg.GetStringValue HKEY_LOCAL_MACHINE, strRegKey, "Hostname", strHostname
If that's what you actually want, you should move the code outside the loop, because the value of strHostname won't change:
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!" & _
"//./root/default:StdRegProv")
objReg.GetStringValue HKEY_LOCAL_MACHINE, strRegKey, "Hostname", strHostname
For Each strComputer In arrComputers
'...
Next
If you actually want the name of the remote computer (which would make a lot more sense when the rest of the information is from the remote computer as well), you could simply use strComputer and remove the registry query entirely.
Can anyone help me where i do mistake ?
this script is for monitoring folder for create, delete or modified text files
sPath = "C:\scripts\test"
sComputer = "."
sDrive = split(sPath,":")(0)
sFolders1 = split(sPath,":")(1)
sFolders = REPLACE(sFolders1, "\", "\\") & "\\"
Set objWMIService = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")
Set colMonitoredEvents = objWMIService.ExecNotificationQuery _
("SELECT * FROM __InstanceOperationEvent WITHIN 1 WHERE " _
& "TargetInstance ISA 'CIM_DataFile' AND " _
& "TargetInstance.Drive='" & sDrive & "' AND " _
& "TargetInstance.Path='" & sFolders & "' AND " _
& "TargetInstance.Extension = 'txt' ")
Wscript.Echo vbCrlf & Now & vbTab & _
"Begin Monitoring for a Folder " & sDrive & ":" & sFolders1 & " Change Event..." & vbCrlf
Do
Set objLatestEvent = colMonitoredEvents.NextEvent
Select Case objLatestEvent.Path_.Class
Case "__InstanceCreationEvent"
WScript.Echo Now & vbTab & objLatestEvent.TargetInstance.FileName & "." & objLatestEvent.TargetInstance.Extension _
& " was created" & vbCrlf
Case "__InstanceDeletionEvent"
WScript.Echo Now & vbTab & objLatestEvent.TargetInstance.FileName & "." & objLatestEvent.TargetInstance.Extension _
& " was deleted" & vbCrlf
Case "__InstanceModificationEvent"
If objLatestEvent.TargetInstance.LastModified <> _
objLatestEvent.PreviousInstance.LastModified then
WScript.Echo Now & vbTab & objLatestEvent.TargetInstance.FileName & "." & objLatestEvent.TargetInstance.Extension _
& " was modified" & vbCrlf
End If
End Select
Loop
Set objWMIService = nothing
Set colMonitoredEvents = nothing
Set objLatestEvent = nothing
This script is run perfect when i write
sPath = "\\ComputerName\C$\scripts\test"
insted of
sPath = "C:\scripts\test"
Thank you....
If you google for "WMI TargetInstance.Drive", you'll see that the drive letter needs a colon. A query like
SELECT * FROM __InstanceOperationEvent WITHIN 1 WHERE TargetInstance ISA 'CIM_DataFile' AND TargetInstance.Drive='E:' AND TargetInstance.Path='\\trials\\SoTrials\\answers\\10041057\\data\\' AND TargetInstance.Extension = 'txt'
works as expected.
I'm a beginner in VBscript and I got a script which obtains disk space usage of local drives. However, when some columns would contain long numeric value, some adjacent columns and even values are moving to the right and thus makes the output disorganized. I already
Please see below the contents of the script:
Option Explicit
const strComputer = "."
const strReport = "F:\dba_scripts\diskspace.txt"
Dim objWMIService, objItem, colItems
Dim strDriveType, strDiskSize, txt
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk WHERE DriveType=3")
txt = "DRIVE" & vbtab & vbtab & "SIZE" & vbtab & vbtab & "USED" & vbtab & vbtab & "FREE" & vbtab & vbtab & "FREE(%)" & vbcrlf
For Each objItem in colItems
DIM pctFreeSpace,strFreeSpace,strusedSpace
pctFreeSpace = INT((objItem.FreeSpace / objItem.Size) * 1000)/10
strDiskSize = round((objItem.Size /1073741824),1) & " GB"
strFreeSpace = round((objItem.FreeSpace /1073741824),1) & " GB"
strUsedSpace = round(((objItem.Size-objItem.FreeSpace)/1073741824),1) & " GB"
txt = txt & objItem.Name & vbtab & vbtab & strDiskSize & vbtab & vbtab & strUsedSpace & vbTab & vbtab & strFreeSpace & vbtab & vbtab & pctFreeSpace & vbcrlf
Next
writeTextFile txt,strReport
wscript.echo "Report written to " & strReport & vbcrlf & vbcrlf & txt
' Procedure to write output to a text file
private sub writeTextFile(byval txt,byval strTextFilePath)
Dim objFSO,objTextFile
set objFSO = createobject("Scripting.FileSystemObject")
set objTextFile = objFSO.CreateTextFile(strTextFilePath)
objTextFile.Write(txt)
objTextFile.Close
SET objTextFile = nothing
end sub
The output file looks OK but when I send/email it using the free bmail, the results are disorganized (meaning some columns and values moved to the right.
My question is are there ways to make the columns and values results fixed ( meaning no columns and values are moving to the right )?
Function RightJustified(ColumnValue, ColumnWidth)
RightJustified = Space(ColumnWidth - Len(ColumnValue)) & ColumnValue
End Function
Usage example:
output = output & _
RightJustified(strDiskSize, 15) & _
RightJustified(strUsedSpace, 15) & _
RightJustified(strFreeSpace, 15) & _
RightJustified(pctFreeSpace, 15) & _
vbCrLf
EDIT
Add the RightJustified function to your script.
Then, replace this line of your code:
txt = txt & objItem.Name & vbtab & vbtab & strDiskSize & vbtab & vbtab & strUsedSpace & vbTab & vbtab & strFreeSpace & vbtab & vbtab & pctFreeSpace & vbcrlf
with:
txt = txt & objItem.Name & _
RightJustified(strDiskSize, 15) & _
RightJustified(strUsedSpace, 15) & _
RightJustified(strFreeSpace, 15) & _
RightJustified(pctFreeSpace, 15) & _
vbCrLf
EDIT 2
I added the RightJustified function at the bottom of your script, and then called it within your loop to format the columns. I also used it on the column headers. Below is the script and at the bottom is the output on my machine.
Option Explicit
const strComputer = "."
const strReport = "F:\dba_scripts\diskspace.txt"
Dim objWMIService, objItem, colItems
Dim strDriveType, strDiskSize, txt
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk WHERE DriveType=3")
txt = RightJustified("DRIVE", 10) & _
RightJustified("SIZE", 15) & _
RightJustified("USED", 15) & _
RightJustified("FREE", 15) & _
RightJustified("FREE(%)", 15) & _
vbCrLf
For Each objItem in colItems
DIM pctFreeSpace,strFreeSpace,strusedSpace
pctFreeSpace = INT((objItem.FreeSpace / objItem.Size) * 1000)/10
strDiskSize = round((objItem.Size /1073741824),1) & " GB"
strFreeSpace = round((objItem.FreeSpace /1073741824),1) & " GB"
strUsedSpace = round(((objItem.Size-objItem.FreeSpace)/1073741824),1) & " GB"
txt = txt & _
RightJustified(objItem.Name, 10) & _
RightJustified(strDiskSize, 15) & _
RightJustified(strUsedSpace, 15) & _
RightJustified(strFreeSpace, 15) & _
RightJustified(pctFreeSpace, 15) & _
vbCrLf
Next
writeTextFile txt,strReport
wscript.echo "Report written to " & strReport & vbcrlf & vbcrlf & txt
' Procedure to write output to a text file
Sub writeTextFile(byval txt,byval strTextFilePath)
Dim objFSO,objTextFile
set objFSO = createobject("Scripting.FileSystemObject")
set objTextFile = objFSO.CreateTextFile(strTextFilePath)
objTextFile.Write(txt)
objTextFile.Close
Set objTextFile = nothing
End Sub
Function RightJustified(ColumnValue, ColumnWidth)
RightJustified = Space(ColumnWidth - Len(ColumnValue)) & ColumnValue
End Function
Output produced:
DRIVE SIZE USED FREE FREE(%)
C: 48.4 GB 40.6 GB 7.8 GB 16.1
D: 100.6 GB 56.8 GB 43.8 GB 43.5
You could write out a table using HTML. This should work in an email.