-
In support of this Thread https://excelfox.com/forum/showthrea...ed-on-Criteria
https://excelfox.com/forum/showthread.php/2774-Summarize-Data-from-Dates-to-Months-based-on-Criteria
https://i.postimg.cc/14gZ3Xtb/Case-Tracker.jpg
_____ Workbook: Project Tracker.xlsx ( Using Excel 2007 32 bit )
| Row\Col |
B |
C |
D |
|---|
| 2 |
DATE |
CONTRACT NO. |
STATUS |
| 3 |
01-Jul-21 |
|
NOT STARTED |
| 4 |
01-Aug-21 |
|
IN PROGRESS |
| 5 |
02-Aug-21 |
|
COMPLETE |
| 6 |
09-Sep-21 |
|
ON HOLD |
| 7 |
21-Oct-21 |
|
NOT STARTED |
| 8 |
22-Oct-21 |
|
IN PROGRESS |
| 9 |
03-Nov-21 |
|
COMPLETE |
| 10 |
05-Nov-21 |
|
ON HOLD |
| 11 |
12-Dec-21 |
|
COMPLETE |
| 12 |
22-Dec-21 |
|
ON HOLD |
https://i.postimg.cc/H87GZZRT/Summary.jpg
_____ Workbook: Project Tracker.xlsx ( Using Excel 2007 32 bit )
| Row\Col |
B |
C |
D |
E |
F |
|---|
| 2 |
DATE |
NOT STARTED |
IN PROGRESS |
ON HOLD |
COMPLETE |
| 3 |
Aug-21 |
|
|
|
|
| 4 |
Sep-21 |
|
|
|
|
| 5 |
Oct-21 |
|
|
|
|
| 6 |
Nov-21 |
|
|
|
|
| 7 |
Dec-21 |
|
|
|
|
| 8 |
Jan-22 |
|
|
|
|
| 9 |
Feb-22 |
|
|
|
|
| 10 |
Mar-22 |
|
|
|
|
| 11 |
Apr-22 |
|
|
|
|
| 12 |
May-22 |
|
|
|
|
| 13 |
Jun-22 |
|
|
|
|
| 14 |
Jul-22 |
|
|
|
|
| 15 |
Aug-22 |
|
|
|
|
| 16 |
Sep-22 |
|
|
|
|
| 17 |
Oct-22 |
|
|
|
|
| 18 |
Nov-22 |
|
|
|
|
| 19 |
Dec-22 |
|
|
|
|
results after running macro here https://excelfox.com/forum/showthread.php/2774-Summarize-Data-from-Dates-to-Months-based-on-Criteria?p=16306&viewfull=1#post16306 https://excelfox.com/forum/showthrea...ll=1#post16306
_____ Workbook: Project Tracker.xls ( Using Excel 2007 32 bit )
| Row\Col |
B |
C |
D |
E |
F |
|---|
| 2 |
DATE |
NOT STARTED |
IN PROGRESS |
ON HOLD |
COMPLETE |
| 3 |
Aug-21 |
|
1 |
|
1 |
| 4 |
Sep-21 |
|
|
1 |
|
| 5 |
Oct-21 |
1 |
1 |
|
|
| 6 |
Nov-21 |
|
|
1 |
1 |
| 7 |
Dec-21 |
|
|
1 |
1 |
| 8 |
Jan-22 |
|
|
|
|
| 9 |
Feb-22 |
|
|
|
|
| 10 |
Mar-22 |
|
|
|
|
| 11 |
Apr-22 |
|
|
|
|
| 12 |
May-22 |
|
|
|
|
| 13 |
Jun-22 |
|
|
|
|
| 14 |
Jul-22 |
|
|
|
|
| 15 |
Aug-22 |
|
|
|
|
| 16 |
Sep-22 |
|
|
|
|
| 17 |
Oct-22 |
|
|
|
|
| 18 |
Nov-22 |
|
|
|
|
| 19 |
Dec-22 |
|
|
|
|
-
3 Attachment(s)
In support of the forum post:
NOT POSTED YET – DRAFT COPY
Hi
I am new to PowerShell script since a few weeks
I hit my first major coding problem, I have got over some smaller ones.
I have a GUI with lots of buttons on it. Each Button has some various things behind it. Some do some quite major things to the computer, such as registry changes, others download stuff. With one exception all is working as it should**.
Problem Summary
This coding does what it should. I checked it on a few computers with different Windows 10 versions. It checks for installed winget on the computer, and if not there attempts to download it. ( That download might not work for other reasons, but that is a separate issue which I am not concerned with here – as it happens I have it installed on all my computers )
On all my current computers that have winget, the message comes up saying 'winget already installed', and the coding moves on. All is well
Code:
Write-Host "Checking winget..."
if (Test-Path ~\AppData\Local\Microsoft\WindowsApps\winget.exe){ # Check if winget is installed
'Winget Already Installed'
}
else{
# Installing winget from the Microsoft Store
Write-Host "Winget not found, installing it now."
$ResultText.text = "`r`n" +"`r`n" + "Installing Winget... Please Wait"
Start-Process "ms-appinstaller:?source=https://aka.ms/getwinget" # If I paste that link in Browser URL I get this offered as if I hit the download button somewhere Microsoft.DesktopAppInstaller_8wekyb3d8bbwe.msixbundle
$nid = (Get-Process AppInstaller).Id
Wait-Process -Id $nid
Write-Host Winget Installed
$ResultText.text = "`r`n" +"`r`n" + "Winget Installed - Ready for Next Task"
} # })
I put that same coding behind a button on a GUI. It seems to work initially, the GUI comes up,
https://i.postimg.cc/xJ3g9CzX/GUI-comes-up.jpg
, and on clicking the button it appears initially to start OK, , but on the same computers, the coding always hangs at
"checking winget…"
Code:
#
Add-Type -AssemblyName System.Windows.Forms
# Create a new form
$Form = New-Object system.Windows.Forms.Form
# Define the size
$Form.ClientSize = '800, 600'
# Range to put button in
$Panel10 = New-Object system.Windows.Forms.Panel ; $Panel10.height = 50 ; $Panel10.width = 250 ; $Panel10.location = New-Object System.Drawing.Point(1, 25)
# function to create sinple botton
function Create-Button {param([string]$Text, [int]$FntSz, [int]$Width, [int]$Height, [int]$ClmX, [int]$RwY)#As Object ' This function allows us to make a buttons in one line. (Those later single lines do not make the button appear)
$Btn = New-Object System.Windows.Forms.Button #
$Btn.Text = $Text #
$Btn.Width = $Width ; $Btn.Height = $Height #
#
$Btn.Location = New-Object System.Drawing.Point($ClmX, $RwY) #
$Btn.Font = New-Object System.Drawing.Font('Arial', $FntSz) # ('Microsoft Sans Serif', 9)
#
return $Btn } #
# Make button
$GetWinGet = Create-Button -Text "winget" -FntSz 9 -Width 117 -Height 21 -ClmX 3 -RwY 1
$GetWinGet.Add_Click({
Write-Host "Checking winget..." # PROBLEM!!!! This wont work in a button - it freezes here?
if (Test-Path ~\AppData\Local\Microsoft\WindowsApps\winget.exe){ # Check if winget is installed
'Winget Already Installed'
}
else{
# Installing winget from the Microsoft Store
Write-Host "Winget not found, installing it now."
$ResultText.text = "`r`n" +"`r`n" + "Installing Winget... Please Wait"
Start-Process "ms-appinstaller:?source=https://aka.ms/getwinget" # If I paste that link in Browser URL I get this offered as if I hit the download button somewhere Microsoft.DesktopAppInstaller_8wekyb3d8bbwe.msixbundle
$nid = (Get-Process AppInstaller).Id
Wait-Process -Id $nid
Write-Host Winget Installed
$ResultText.text = "`r`n" +"`r`n" + "Winget Installed - Ready for Next Task"
} })
# Add Button to range
$Panel10.controls.AddRange(@($GetWinGet))
# Add ranbge to Form
$Form.controls.AddRange(@($Panel10))
# Display the form
[void]$Form.ShowDialog()
On this same GUI I can put lots of other buttons, all doing different things, and they always do what they should**
What am I missing?
Alan
-
Test
HTML Code:
#
Add-Type -AssemblyName System.Windows.Forms
# Create a new form
$Form = New-Object system.Windows.Forms.Form
# Define the size, title and background color
$Form.ClientSize = '800, 600'
# Range to put button in
$Panel10 = New-Object system.Windows.Forms.Panel ; $Panel10.height = 50 ; $Panel10.width = 250 ; $Panel10.location = New-Object System.Drawing.Point(1, 25)
# function to create sinple botton
function Create-Button {param([string]$Text, [int]$FntSz, [int]$Width, [int]$Height, [int]$ClmX, [int]$RwY)#As Object ' This function allows us to make a buttons in one line. (Those later single lines do not make the button appear)
$Btn = New-Object System.Windows.Forms.Button #
$Btn.Text = $Text #
$Btn.Width = $Width ; $Btn.Height = $Height #
#
$Btn.Location = New-Object System.Drawing.Point($ClmX, $RwY) #
$Btn.Font = New-Object System.Drawing.Font('Arial', $FntSz) # ('Microsoft Sans Serif', 9)
#
return $Btn } #
# Make button
$GetWinGet = Create-Button -Text "winget" -FntSz 9 -Width 117 -Height 21 -ClmX 3 -RwY 1 # $firefox.width = 212
$GetWinGet.Add_Click({
Write-Host "Checking winget..." # PROBLEM!!!! This wont work in a button - it freezes here?
if (Test-Path ~\AppData\Local\Microsoft\WindowsApps\winget.exe){ # Check if winget is installed
'Winget Already Installed'
}
else{
# Installing winget from the Microsoft Store
Write-Host "Winget not found, installing it now."
$ResultText.text = "`r`n" +"`r`n" + "Installing Winget... Please Wait"
Start-Process "ms-appinstaller:?source=https://aka.ms/getwinget" # If I paste that link in Browser URL I get this offered as if I hit the download button somewhere Microsoft.DesktopAppInstaller_8wekyb3d8bbwe.msixbundle #$vscode.width = 211
$nid = (Get-Process AppInstaller).Id
Wait-Process -Id $nid
Write-Host Winget Installed
$ResultText.text = "`r`n" +"`r`n" + "Winget Installed - Ready for Next Task"
} })
# Add Button to range
$Panel10.controls.AddRange(@($GetWinGet))
# Add ranbge to Form
$Form.controls.AddRange(@($Panel10))
# Display the form
[void]$Form.ShowDialog()
PHP Code:
#
Add-Type -AssemblyName System.Windows.Forms
# Create a new form
$Form = New-Object system.Windows.Forms.Form
# Define the size, title and background color
$Form.ClientSize = '800, 600'
# Range to put button in
$Panel10 = New-Object system.Windows.Forms.Panel ; $Panel10.height = 50 ; $Panel10.width = 250 ; $Panel10.location = New-Object System.Drawing.Point(1, 25)
# function to create sinple botton
function Create-Button {param([string]$Text, [int]$FntSz, [int]$Width, [int]$Height, [int]$ClmX, [int]$RwY)#As Object ' This function allows us to make a buttons in one line. (Those later single lines do not make the button appear)
$Btn = New-Object System.Windows.Forms.Button #
$Btn.Text = $Text #
$Btn.Width = $Width ; $Btn.Height = $Height #
#
$Btn.Location = New-Object System.Drawing.Point($ClmX, $RwY) #
$Btn.Font = New-Object System.Drawing.Font('Arial', $FntSz) # ('Microsoft Sans Serif', 9)
#
return $Btn } #
# Make button
$GetWinGet = Create-Button -Text "winget" -FntSz 9 -Width 117 -Height 21 -ClmX 3 -RwY 1 # $firefox.width = 212
$GetWinGet.Add_Click({
Write-Host "Checking winget..." # PROBLEM!!!! This wont work in a button - it freezes here?
if (Test-Path ~\AppData\Local\Microsoft\WindowsApps\winget.exe){ # Check if winget is installed
'Winget Already Installed'
}
else{
# Installing winget from the Microsoft Store
Write-Host "Winget not found, installing it now."
$ResultText.text = "`r`n" +"`r`n" + "Installing Winget... Please Wait"
Start-Process "ms-appinstaller:?source=https://aka.ms/getwinget" # If I paste that link in Browser URL I get this offered as if I hit the download button somewhere Microsoft.DesktopAppInstaller_8wekyb3d8bbwe.msixbundle #$vscode.width = 211
$nid = (Get-Process AppInstaller).Id
Wait-Process -Id $nid
Write-Host Winget Installed
$ResultText.text = "`r`n" +"`r`n" + "Winget Installed - Ready for Next Task"
} })
# Add Button to range
$Panel10.controls.AddRange(@($GetWinGet))
# Add ranbge to Form
$Form.controls.AddRange(@($Panel10))
# Display the form
[void]$Form.ShowDialog()
-
In support of this forum post
https://excelfox.com/forum/showthrea...ll=1#post16373
_____ Workbook: Work_file.xlsm ( Using Excel 2007 32 bit )
| Row\Col |
A |
B |
C |
D |
E |
F |
G |
H |
I |
|---|
| 1 |
S.No. |
Year |
Month |
Name |
Project |
Task |
Amount |
Submitted By |
|
| 2 |
1 |
2022 |
January |
bbb |
Project2 |
Task2 |
100 |
Liviu Popescu |
|
| 3 |
2 |
2022 |
February |
ccc |
Project5 |
Task1 |
200 |
Liviu Popescu |
|
| 4 |
3 |
2022 |
March |
aaa |
Project3 |
Task2 |
500 |
Liviu Popescu |
|
| 5 |
|
|
|
|
|
|
|
|
|
_____ Workbook: Work_file.xlsm ( Using Excel 2007 32 bit )
| Row\Col |
A |
B |
C |
D |
E |
F |
G |
|---|
| 1 |
Name |
Project |
Task |
01-22 |
02-22 |
03-22 |
04-22 |
| 2 |
aaa |
Project1 |
Task1 |
|
|
|
|
| 3 |
aaa |
Project1 |
Task2 |
|
|
|
|
| 4 |
aaa |
Project2 |
Task1 |
|
|
|
|
| 5 |
aaa |
Project2 |
Task2 |
|
|
|
|
| 6 |
aaa |
Project3 |
Task1 |
|
|
|
|
| 7 |
aaa |
Project3 |
Task2 |
|
|
|
|
| 8 |
aaa |
Project4 |
Task1 |
|
|
|
|
| 9 |
aaa |
Project4 |
Task2 |
|
|
|
|
| 10 |
aaa |
Project5 |
Task1 |
|
|
|
|
| 11 |
aaa |
Project5 |
Task2 |
|
|
|
|
| 12 |
bbb |
Project1 |
Task1 |
|
|
|
|
| 13 |
bbb |
Project1 |
Task2 |
|
|
|
|
| 14 |
bbb |
Project2 |
Task1 |
|
|
|
|
| 15 |
bbb |
Project2 |
Task2 |
|
|
|
|
| 16 |
bbb |
Project3 |
Task1 |
|
|
|
|
| 17 |
bbb |
Project3 |
Task2 |
|
|
|
|
| 18 |
bbb |
Project4 |
Task1 |
|
|
|
|
| 19 |
bbb |
Project4 |
Task2 |
|
|
|
|
| 20 |
bbb |
Project5 |
Task1 |
|
|
|
|
| 21 |
bbb |
Project5 |
Task2 |
|
|
|
|
| 22 |
ccc |
Project1 |
Task1 |
|
|
|
|
| 23 |
ccc |
Project1 |
Task2 |
|
|
|
|
| 24 |
ccc |
Project2 |
Task1 |
|
|
|
|
| 25 |
ccc |
Project2 |
Task2 |
|
|
|
|
| 26 |
ccc |
Project3 |
Task1 |
|
|
|
|
| 27 |
ccc |
Project3 |
Task2 |
|
|
|
|
| 28 |
ccc |
Project4 |
Task1 |
|
|
|
|
| 29 |
ccc |
Project4 |
Task2 |
|
|
|
|
| 30 |
ccc |
Project5 |
Task1 |
|
|
|
|
| 31 |
ccc |
Project5 |
Task2 |
|
|
|
|
| 32 |
ddd |
Project1 |
Task1 |
|
|
|
|
| 33 |
ddd |
Project1 |
Task2 |
|
|
|
|
-
In support of this forum post
https://excelfox.com/forum/showthrea...ll=1#post16376
Before, as we had before
_____ Workbook: Work_file.xlsm ( Using Excel 2007 32 bit )
| Row\Col |
A |
B |
C |
D |
E |
F |
G |
H |
I |
|---|
| 1 |
S.No. |
Year |
Month |
Name |
Project |
Task |
Amount |
Submitted By |
|
| 2 |
1 |
2022 |
January |
bbb |
Project2 |
Task2 |
100 |
Liviu Popescu |
|
| 3 |
2 |
2022 |
February |
ccc |
Project5 |
Task1 |
200 |
Liviu Popescu |
|
| 4 |
3 |
2022 |
March |
aaa |
Project3 |
Task2 |
500 |
Liviu Popescu |
|
| 5 |
|
|
|
|
|
|
|
|
|
_____ Workbook: Work_file.xlsm ( Using Excel 2007 32 bit )
| Row\Col |
A |
B |
C |
D |
E |
F |
G |
|---|
| 1 |
Name |
Project |
Task |
01-22 |
02-22 |
03-22 |
04-22 |
| 2 |
aaa |
Project1 |
Task1 |
|
|
|
|
| 3 |
aaa |
Project1 |
Task2 |
|
|
|
|
| 4 |
aaa |
Project2 |
Task1 |
|
|
|
|
| 5 |
aaa |
Project2 |
Task2 |
|
|
|
|
| 6 |
aaa |
Project3 |
Task1 |
|
|
|
|
| 7 |
aaa |
Project3 |
Task2 |
|
|
|
|
| 8 |
aaa |
Project4 |
Task1 |
|
|
|
|
| 9 |
aaa |
Project4 |
Task2 |
|
|
|
|
| 10 |
aaa |
Project5 |
Task1 |
|
|
|
|
| 11 |
aaa |
Project5 |
Task2 |
|
|
|
|
| 12 |
bbb |
Project1 |
Task1 |
|
|
|
|
| 13 |
bbb |
Project1 |
Task2 |
|
|
|
|
| 14 |
bbb |
Project2 |
Task1 |
|
|
|
|
| 15 |
bbb |
Project2 |
Task2 |
|
|
|
|
| 16 |
bbb |
Project3 |
Task1 |
|
|
|
|
| 17 |
bbb |
Project3 |
Task2 |
|
|
|
|
| 18 |
bbb |
Project4 |
Task1 |
|
|
|
|
| 19 |
bbb |
Project4 |
Task2 |
|
|
|
|
| 20 |
bbb |
Project5 |
Task1 |
|
|
|
|
| 21 |
bbb |
Project5 |
Task2 |
|
|
|
|
| 22 |
ccc |
Project1 |
Task1 |
|
|
|
|
| 23 |
ccc |
Project1 |
Task2 |
|
|
|
|
| 24 |
ccc |
Project2 |
Task1 |
|
|
|
|
| 25 |
ccc |
Project2 |
Task2 |
|
|
|
|
| 26 |
ccc |
Project3 |
Task1 |
|
|
|
|
| 27 |
ccc |
Project3 |
Task2 |
|
|
|
|
| 28 |
ccc |
Project4 |
Task1 |
|
|
|
|
| 29 |
ccc |
Project4 |
Task2 |
|
|
|
|
| 30 |
ccc |
Project5 |
Task1 |
|
|
|
|
| 31 |
ccc |
Project5 |
Task2 |
|
|
|
|
| 32 |
ddd |
Project1 |
Task1 |
|
|
|
|
| 33 |
ddd |
Project1 |
Task2 |
|
|
|
|
-
In support of this forum post
https://excelfox.com/forum/showthrea...ll=1#post16376
After
_____ Workbook: Work_file.xlsm ( Using Excel 2007 32 bit )
| Row\Col |
A |
B |
C |
D |
E |
F |
G |
|---|
1 |
Name |
Project |
Task |
01-22 |
02-22 |
03-22 |
04-22 |
2 |
aaa |
Project1 |
Task1 |
|
|
|
|
3 |
aaa |
Project1 |
Task2 |
|
|
|
|
4 |
aaa |
Project2 |
Task1 |
|
|
|
|
5 |
aaa |
Project2 |
Task2 |
|
|
|
|
6 |
aaa |
Project3 |
Task1 |
|
|
|
|
7 |
aaa |
Project3 |
Task2 |
|
|
500 |
|
8 |
aaa |
Project4 |
Task1 |
|
|
|
|
9 |
aaa |
Project4 |
Task2 |
|
|
|
|
10 |
aaa |
Project5 |
Task1 |
|
|
|
|
11 |
aaa |
Project5 |
Task2 |
|
|
|
|
12 |
bbb |
Project1 |
Task1 |
|
|
|
|
13 |
bbb |
Project1 |
Task2 |
|
|
|
|
14 |
bbb |
Project2 |
Task1 |
|
|
|
|
15 |
bbb |
Project2 |
Task2 |
100 |
|
|
|
16 |
bbb |
Project3 |
Task1 |
|
|
|
|
17 |
bbb |
Project3 |
Task2 |
|
|
|
|
18 |
bbb |
Project4 |
Task1 |
|
|
|
|
19 |
bbb |
Project4 |
Task2 |
|
|
|
|
20 |
bbb |
Project5 |
Task1 |
|
|
|
|
21 |
bbb |
Project5 |
Task2 |
|
|
|
|
22 |
ccc |
Project1 |
Task1 |
|
|
|
|
23 |
ccc |
Project1 |
Task2 |
|
|
|
|
24 |
ccc |
Project2 |
Task1 |
|
|
|
|
25 |
ccc |
Project2 |
Task2 |
|
|
|
|
26 |
ccc |
Project3 |
Task1 |
|
|
|
|
27 |
ccc |
Project3 |
Task2 |
|
|
|
|
28 |
ccc |
Project4 |
Task1 |
|
|
|
|
29 |
ccc |
Project4 |
Task2 |
|
|
|
|
30 |
ccc |
Project5 |
Task1 |
|
200 |
|
|
31 |
ccc |
Project5 |
Task2 |
|
|
|
|
32 |
ddd |
Project1 |
Task1 |
|
|
|
|
-
In support of this forum post
https://excelfox.com/forum/showthrea...ll=1#post16376
After
_____ Workbook: Work_file.xlsm ( Using Excel 2007 32 bit )
| Row\Col |
A |
B |
C |
D |
E |
F |
G |
|---|
1 |
Name |
Project |
Task |
01-22 |
02-22 |
03-22 |
04-22 |
2 |
aaa |
Project1 |
Task1 |
|
|
|
|
3 |
aaa |
Project1 |
Task2 |
|
|
|
|
4 |
aaa |
Project2 |
Task1 |
|
|
|
|
5 |
aaa |
Project2 |
Task2 |
|
|
|
|
6 |
aaa |
Project3 |
Task1 |
|
|
|
|
7 |
aaa |
Project3 |
Task2 |
|
|
500 |
|
8 |
aaa |
Project4 |
Task1 |
|
|
|
|
9 |
aaa |
Project4 |
Task2 |
|
|
|
|
10 |
aaa |
Project5 |
Task1 |
|
|
|
|
11 |
aaa |
Project5 |
Task2 |
|
|
|
|
12 |
bbb |
Project1 |
Task1 |
|
|
|
|
13 |
bbb |
Project1 |
Task2 |
|
|
|
|
14 |
bbb |
Project2 |
Task1 |
|
|
|
|
15 |
bbb |
Project2 |
Task2 |
100 |
|
|
|
16 |
bbb |
Project3 |
Task1 |
|
|
|
|
17 |
bbb |
Project3 |
Task2 |
|
|
|
|
18 |
bbb |
Project4 |
Task1 |
|
|
|
|
19 |
bbb |
Project4 |
Task2 |
|
|
|
|
20 |
bbb |
Project5 |
Task1 |
|
|
|
|
21 |
bbb |
Project5 |
Task2 |
|
|
|
|
22 |
ccc |
Project1 |
Task1 |
|
|
|
|
23 |
ccc |
Project1 |
Task2 |
|
|
|
|
24 |
ccc |
Project2 |
Task1 |
|
|
|
|
25 |
ccc |
Project2 |
Task2 |
|
|
|
|
26 |
ccc |
Project3 |
Task1 |
|
|
|
|
27 |
ccc |
Project3 |
Task2 |
|
|
|
|
28 |
ccc |
Project4 |
Task1 |
|
|
|
|
29 |
ccc |
Project4 |
Task2 |
|
|
|
|
30 |
ccc |
Project5 |
Task1 |
|
200 |
|
|
31 |
ccc |
Project5 |
Task2 |
|
|
|
|
32 |
ddd |
Project1 |
Task1 |
|
|
|
|
-
In support of these forum posts
https://excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page51#post12776
https://excelfox.com/forum/showthrea...5356#post15356
https://eileenslounge.com/viewtopic.php?f=18&t=37740
https://eileenslounge.com/viewtopic.php?f=18&t=37712
https://eileenslounge.com/viewtopic.php?f=18&t=37707
Code:
'Version : 5.1.19041.1320
'InstanceId : e165cf30-9ddd-49ed-96c7-59cca98516ee
'UI: System.Management.Automation.Internal.Host.InternalHostUserInterface
'CurrentCulture: DE -DE
'CurrentUICulture: DE -DE
'PrivateData: Microsoft.PowerShell.Host.ISE.ISEOptions
'DebuggerEnabled : True
'IsRunspacePushed : False
'Runspace: System.Management.Automation.Runspaces.LocalRunspace
'https://excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page51#post12776
'https://excelfox.com/forum/showthread.php/2559-Notes-tests-text-files-manipulation-of-text-files-in-Excel-and-with-Excel-VBA?p=15356#post15356
'https://eileenslounge.com/viewtopic.php?f=18&t=37740
'https://eileenslounge.com/viewtopic.php?f=18&t=37712
'https://eileenslounge.com/viewtopic.php?f=18&t=37707
Sub Services() ' https://excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page51#post12776 https://excelfox.com/forum/showthread.php/2559-Notes-tests-text-files-manipulation-of-text-files-in-Excel-and-with-Excel-VBA?p=15356#post15356
' PowerShell
Dim PScmdLet As String, cmdLet As String
'Let cmdLet = "Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\acer\Desktop\test.txt' -Width 1000"
Let cmdLet = "Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath '" & ThisWorkbook.Path & Application.PathSeparator & "test.txt' -Width 1000"
Let PScmdLet = "powershell -command " & cmdLet ' https://www.devhut.net/vba-run-powershell-command/
CreateObject("WScript.Shell").Exec (PScmdLet)
' Get the text file as a long single string
Dim FileNum As Long: Let FileNum = FreeFile(1) ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
Let PathAndFileName = ThisWorkbook.Path & Application.PathSeparator & "test.txt" ' CHANGE TO SUIT From vixer zyxw1234 : http://www.eileenslounge.com/viewtopic.php?f=30&t=34629 DF.txt https://app.box.com/s/gw941dh9v8sqhvzin3lo9rfc67fjsbic
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundamental type data input...
Let TotalFile = Space(LOF(FileNum)) '....and wot receives it has to be a string of exactly the right length
Get #FileNum, , TotalFile 'Debug.Print TotalFile
Let TotalFile = Replace(TotalFile, Chr(0), "", 1, -1, vbBinaryCompare) ' There seems to be a lot of Chr(0)s in the string https://i.postimg.cc/t43HCQr9/Rather-a-lot-of-Chr-0-s.jpg
'Let TotalFile = Replace(TotalFile, Chr(255) & Chr(254) & vbCr & vbLf, "", 1, 1, vbBinaryCompare) ' this would tsake the first bit of crap out, (alternatively we can just take out the first line when split later by
Close #FileNum
' Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(TotalFile)
' make a 1 D array of the text file lines
Dim arrRws() As String: Let arrRws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare)
' make array for output
Dim arrOut() As String: ReDim arrOut(1 To UBound(arrRws()) - 2, 1 To 3) ' we are ignoring the first 3 lines. The UBound of the 1 dimensional array is already 1 less then the lines we need because a 1 dimensional array starts at 0
Dim Cnt As Long
For Cnt = 1 To UBound(arrRws()) - 2
If arrRws(Cnt + 2) = "" Then
' This should occur at the last empty rows, so we could consider jumping out of the loop here
Else
' time to split the line string
Dim Pos1 As Long: Let Pos1 = InStr(1, arrRws(Cnt + 2), " ", vbBinaryCompare)
Dim Nme As String: Let Nme = Left(arrRws(Cnt + 2), Pos1 - 1)
Dim Pos3 As Long: Let Pos3 = Len(arrRws(Cnt + 2)) - InStrRev(arrRws(Cnt + 2), " ", -1, vbBinaryCompare)
Dim StrtTyp As String: Let StrtTyp = Right(arrRws(Cnt + 2), Pos3)
Dim DispNme As String: Let DispNme = Replace(arrRws(Cnt + 2), Nme, "", 1, -1, vbBinaryCompare)
Let DispNme = Replace(DispNme, StrtTyp, "", 1, -1, vbBinaryCompare)
Let DispNme = Trim(DispNme)
' fill the array for output
Let arrOut(Cnt, 1) = Nme: arrOut(Cnt, 2) = DispNme: arrOut(Cnt, 3) = StrtTyp
End If
Next Cnt
' Chuck array into a spreadsheet
Let ThisWorkbook.Worksheets("PowerShell").Range("A2").Resize(UBound(arrOut(), 1), 3).Value = arrOut()
ThisWorkbook.Worksheets("PowerShell").Cells.Columns("A:C").EntireColumn.AutoFit
End Sub
Edit Some issues…
I messed up with a few things.
_ the display name could be long and go up to the startuptype in the text file, which messed up the manipulation of a line of data from the text file a bit. For now I fiddled that by adding some spaces before the words used for the startuptype. A better solution will probably wait until I fully understand the PowerShell code line
_ There seems to be some strange effects with something somewhere working too slow, too fast or not giving accurate information about if a text file is present. For now that is fiddled with some Waits , Dirs and a Kill. That will do for now, but that need to be looked at again when I understand better wots going on
The next code version is in the next post
https://excelfox.com/forum/showthrea...ll=1#post16369
-
In support of these forum posts
https://excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page51#post12776
https://excelfox.com/forum/showthrea...5356#post15356
https://eileenslounge.com/viewtopic.php?f=18&t=37740
https://eileenslounge.com/viewtopic.php?f=18&t=37712
https://eileenslounge.com/viewtopic.php?f=18&t=37707
Code:
'Version : 5.1.19041.1320
'InstanceId : e165cf30-9ddd-49ed-96c7-59cca98516ee
'UI: System.Management.Automation.Internal.Host.InternalHostUserInterface
'CurrentCulture: DE -DE
'CurrentUICulture: DE -DE
'PrivateData: Microsoft.PowerShell.Host.ISE.ISEOptions
'DebuggerEnabled : True
'IsRunspacePushed : False
'Runspace: System.Management.Automation.Runspaces.LocalRunspace
'https://excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page51#post12776
'https://excelfox.com/forum/showthread.php/2559-Notes-tests-text-files-manipulation-of-text-files-in-Excel-and-with-Excel-VBA?p=15356#post15356
'https://eileenslounge.com/viewtopic.php?f=18&t=37740
'https://eileenslounge.com/viewtopic.php?f=18&t=37712
'https://eileenslounge.com/viewtopic.php?f=18&t=37707
Sub Services() ' https://excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page51#post12776 https://excelfox.com/forum/showthread.php/2559-Notes-tests-text-files-manipulation-of-text-files-in-Excel-and-with-Excel-VBA?p=15356#post15356
' PowerShell
Dim PScmdLet As String, cmdLet As String
'Let cmdLet = "Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\acer\Desktop\test.txt' -Width 1000"
Let cmdLet = "Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath '" & ThisWorkbook.Path & Application.PathSeparator & "test.txt' -Width 1000"
Let PScmdLet = "powershell -command " & cmdLet ' https://www.devhut.net/vba-run-powershell-command/
CreateObject("WScript.Shell").Exec (PScmdLet)
' Get the text file as a long single string
Dim FileNum As Long: Let FileNum = FreeFile(1) ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
Let PathAndFileName = ThisWorkbook.Path & Application.PathSeparator & "test.txt" ' CHANGE TO SUIT From vixer zyxw1234 : http://www.eileenslounge.com/viewtopic.php?f=30&t=34629 DF.txt https://app.box.com/s/gw941dh9v8sqhvzin3lo9rfc67fjsbic
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundamental type data input...
Let TotalFile = Space(LOF(FileNum)) '....and wot receives it has to be a string of exactly the right length
Get #FileNum, , TotalFile 'Debug.Print TotalFile
Let TotalFile = Replace(TotalFile, Chr(0), "", 1, -1, vbBinaryCompare) ' There seems to be a lot of Chr(0)s in the string https://i.postimg.cc/t43HCQr9/Rather-a-lot-of-Chr-0-s.jpg
'Let TotalFile = Replace(TotalFile, Chr(255) & Chr(254) & vbCr & vbLf, "", 1, 1, vbBinaryCompare) ' this would tsake the first bit of crap out, (alternatively we can just take out the first line when split later by
Close #FileNum
' Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(TotalFile)
' make a 1 D array of the text file lines
Dim arrRws() As String: Let arrRws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare)
' make array for output
Dim arrOut() As String: ReDim arrOut(1 To UBound(arrRws()) - 2, 1 To 3) ' we are ignoring the first 3 lines. The UBound of the 1 dimensional array is already 1 less then the lines we need because a 1 dimensional array starts at 0
Dim Cnt As Long
For Cnt = 1 To UBound(arrRws()) - 2
If arrRws(Cnt + 2) = "" Then
' This should occur at the last empty rows, so we could consider jumping out of the loop here
Else
' time to split the line string
Dim Pos1 As Long: Let Pos1 = InStr(1, arrRws(Cnt + 2), " ", vbBinaryCompare)
Dim Nme As String: Let Nme = Left(arrRws(Cnt + 2), Pos1 - 1)
Dim Pos3 As Long: Let Pos3 = Len(arrRws(Cnt + 2)) - InStrRev(arrRws(Cnt + 2), " ", -1, vbBinaryCompare)
Dim StrtTyp As String: Let StrtTyp = Right(arrRws(Cnt + 2), Pos3)
Dim DispNme As String: Let DispNme = Replace(arrRws(Cnt + 2), Nme, "", 1, -1, vbBinaryCompare)
Let DispNme = Replace(DispNme, StrtTyp, "", 1, -1, vbBinaryCompare)
Let DispNme = Trim(DispNme)
' fill the array for output
Let arrOut(Cnt, 1) = Nme: arrOut(Cnt, 2) = DispNme: arrOut(Cnt, 3) = StrtTyp
End If
Next Cnt
' Chuck array into a spreadsheet
Let ThisWorkbook.Worksheets("PowerShell").Range("A2").Resize(UBound(arrOut(), 1), 3).Value = arrOut()
ThisWorkbook.Worksheets("PowerShell").Cells.Columns("A:C").EntireColumn.AutoFit
End Sub
Edit Some issues…
I messed up with a few things.
_ the display name could be long and go up to the startuptype in the text file, which messed up the manipulation of a line of data from the text file a bit. For now I fiddled that by adding some spaces before the words used for the startuptype. A better solution will probably wait until I fully understand the PowerShell code line
_ There seems to be some strange effects with something somewhere working too slow, too fast or not giving accurate information about if a text file is present. For now that is fiddled with some Waits , Dirs and a Kill. That will do for now, but that need to be looked at again when I understand better wots going on
The next code version is in the next post
https://excelfox.com/forum/showthrea...ll=1#post16369
-
Macro for this post
https://excelfox.com/forum/showthrea...ge51#post12776
Code:
'In support of these forum posts
'https://excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page51#post12776
'https://excelfox.com/forum/showthrea...5356#post15356
'https://eileenslounge.com/viewtopic.php?f=18&t=37740
'https://eileenslounge.com/viewtopic.php?f=18&t=37712
'https://eileenslounge.com/viewtopic.php?f=18&t=37707
Sub Services2() ' https://excelfox.com/forum/showthrea...ge51#post12776 https://excelfox.com/forum/showthrea...5356#post15356
' kill the text file before I make it, because the code might otherwise use a previous one, as it takes a second or so to overwrite the old or make a new one
Do While Dir("" & ThisWorkbook.Path & Application.PathSeparator & "test.txt", vbNormal) <> ""
If Dir("" & ThisWorkbook.Path & Application.PathSeparator & "test.txt", vbNormal) <> "" Then Kill PathName:="" & ThisWorkbook.Path & Application.PathSeparator & "test.txt"
Application.Wait (Now + TimeValue("0:00:01"))
Loop
DoEvents: DoEvents
' Application.Wait (Now + TimeValue("0:00:01")) ' I am not sure why I had to do this. It should not be necerssary, without it the text file is empty - maybe Dir says something is there before it is available to have???
' PowerShell
Dim PScmdLet As String, cmdLet As String
'Let cmdLet = "Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath 'C:\Users\acer\Desktop\test.txt' -Width 1000"
Let cmdLet = "Get-Service|Select-Object name,displayname,starttype|Format-Table -AutoSize|Out-File -FilePath '" & ThisWorkbook.Path & Application.PathSeparator & "test.txt' -Width 2000"
Let PScmdLet = "powershell -command " & cmdLet ' https://www.devhut.net/vba-run-powershell-command/
CreateObject("WScript.Shell").Exec (PScmdLet)
' we need to wait a bit until the text file is made
Do While Dir("" & ThisWorkbook.Path & Application.PathSeparator & "test.txt", vbNormal) = ""
Application.Wait (Now + TimeValue("0:00:01"))
Loop
DoEvents: DoEvents ' I chucked this in, but did not really have any reason
Application.Wait (Now + TimeValue("0:00:02")) ' I am not sure why I had to do this. It should not be necerssary, without it the text file is empty - maybe Dir says something is there before it is available to have??? 01 seemed OK - I made it 2
' Get the text file as a long single string
Dim FileNum As Long: Let FileNum = FreeFile(1) ' https://msdn.microsoft.com/en-us/vba...efile-function
Dim PathAndFileName As String, TotalFile As String
Let PathAndFileName = ThisWorkbook.Path & Application.PathSeparator & "test.txt" ' CHANGE TO SUIT From vixer zyxw1234 : http://www.eileenslounge.com/viewtopic.php?f=30&t=34629 DF.txt https://app.box.com/s/gw941dh9v8sqhvzin3lo9rfc67fjsbic
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundamental type data input...
Let TotalFile = Space(LOF(FileNum)) '....and wot receives it has to be a string of exactly the right length
Get #FileNum, , TotalFile 'Debug.Print TotalFile
Let TotalFile = Replace(TotalFile, Chr(0), "", 1, -1, vbBinaryCompare) ' There seems to be a lot of Chr(0)s in the string https://i.postimg.cc/t43HCQr9/Rather...of-Chr-0-s.jpg
'Let TotalFile = Replace(TotalFile, Chr(255) & Chr(254) & vbCr & vbLf, "", 1, 1, vbBinaryCompare) ' this would tsake the first bit of crap out, (alternatively we can just take out the first line when split later by
Close #FileNum
' Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(TotalFile)
' make a 1 D array of the text file lines
Dim arrRws() As String: Let arrRws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare)
' make array for output
Dim arrOut() As String: ReDim arrOut(1 To UBound(arrRws()) - 2, 1 To 3) ' we are ignoring the first 3 lines. The UBound of the 1 dimensional array is already 1 less then the lines we need because a 1 dimensional array starts at 0
Dim Cnt As Long
For Cnt = 1 To UBound(arrRws()) - 2
If arrRws(Cnt + 2) = "" Then
' This should occur at the last empty rows, so we could consider jumping out of the loop here
Else
' This is a bit of a temporary bodge as the Display name sometimes pushes up to the startuptype which screws up the string manipulation below
Let arrRws(Cnt + 2) = Replace(arrRws(Cnt + 2), "Manual", " Manual", 1, 1, vbBinaryCompare): Let arrRws(Cnt + 2) = Replace(arrRws(Cnt + 2), "Automatic", " Auotomatic", 1, 1, vbBinaryCompare): Let arrRws(Cnt + 2) = Replace(arrRws(Cnt + 2), "Disabled", " Disabled", 1, 1, vbBinaryCompare)
' time to split the line string
Dim Pos1 As Long: Let Pos1 = InStr(1, arrRws(Cnt + 2), " ", vbBinaryCompare)
Dim Nme As String: Let Nme = Left(arrRws(Cnt + 2), Pos1 - 1)
Dim Pos3 As Long: Let Pos3 = Len(arrRws(Cnt + 2)) - InStrRev(arrRws(Cnt + 2), " ", -1, vbBinaryCompare)
Dim StrtTyp As String: Let StrtTyp = Right(arrRws(Cnt + 2), Pos3)
Dim DispNme As String: Let DispNme = Replace(arrRws(Cnt + 2), Nme, "", 1, 1, vbBinaryCompare)
Let DispNme = Replace(DispNme, StrtTyp, "", 1, 1, vbBinaryCompare)
Let DispNme = Trim(DispNme)
' fill the array for output
Let arrOut(Cnt, 1) = Nme: arrOut(Cnt, 2) = DispNme: arrOut(Cnt, 3) = StrtTyp
End If
Next Cnt
' Chuck array into a spreadsheet
Let ThisWorkbook.Worksheets("PowerShell").Range("A2").Resize(UBound(arrOut(), 1), 3).Value = arrOut()
ThisWorkbook.Worksheets("PowerShell").Cells.Columns("A:C").EntireColumn.AutoFit
End Sub
