Makale WScript.Network & WScript.Shell Metot ve Özellikleri

Sub Comp_Domain_User()
    Dim Wsh As Object, a As String, b As String, c As String
    Set Wsh = CreateObject("Wscript.Network")
    'Bilgisayar Adı
    a = Wsh.ComputerName
    'Domain Adı
    b = Wsh.UserDomain
    'Kullanıcı Adı
    c = Wsh.UserName
    MsgBox "Bilgisayar Adı :  " & a & Chr(10) & _
       "Domain    Adı :  " & b & Chr(10) & _
       "Kullanıcı   Adı  : " & c
End Sub

Sub Ag_Surucu_Listele()
    Dim Wsh As Object, a As String, i As Long
    Set Wsh = CreateObject("Wscript.Network")
    'Önce sürücü adı(döngüde çift sayı), sonra paylaşım yolu(tek sayı) düzeniyle listeleniyor.
    'Ör: i = 0 => "Z:",   i = 1 => "\\anemos\SharedDocs"
    For i = 0 To Wsh.EnumNetworkDrives.Count - 1 Step 2
        a = a & "Sürücü Adı: " & Wsh.EnumNetworkDrives(i) & _
        ",  Paylaşım: " & Wsh.EnumNetworkDrives(i + 1) & Chr(10)
    Next i
    MsgBox a
End Sub

Sub Ag_Surucu_Baglan()
    Dim Wsh As Object, ShDrive As String, ShRemote As String, ShFold As String
    Set Wsh = CreateObject("Wscript.Network")
    ShDrive = "Y:"
    ShRemote = "\\anemos"
    ShFold = "SharedDocs"
    Wsh.MapNetworkDrive ShDrive, ShRemote & "\" & ShFold
End Sub

Sub Comp_Domain_User()
    Dim Wsh As Object
    Set Wsh = CreateObject("Wscript.Network")
    Wsh.RemoveNetworkDrive "Y:"
End Sub

Sub Yazicilar()
    Dim Wsh As Object, a As String, sor As Byte, i As Byte
    Set Wsh = CreateObject("Wscript.Network")
    'Bilgisayara ait yazıcılar listesi
    a = "Varsayılan yazıcıyı değiştirmek ister misiniz?" & Chr(10) & Chr(10) & _
    "Değiştirmek isterseniz, 'OK' seçmeden önce bu listede görünen yazıcı kodunu yazın." & Chr(10) & Chr(10)
    
    a = a & "Bağlı Yazıcılar..." & Chr(10)
    
    For i = 0 To Wsh.EnumPrinterConnections.Count - 1
        a = a & Chr(10) & i + 1 & "-) " & Wsh.EnumPrinterConnections(i)
    Next
    
    sor = Val(InputBox(a, "Excel", 1))
    
    If sor = False Then Exit Sub
    'Varsayılan yazıcının değişimi
    Wsh.SetDefaultPrinter (Wsh.EnumPrinterConnections(sor - 1))
    MsgBox "Yazıcı değiştirildi.", vbInformation, "Excel"
End Sub

Sub Belgelerim()
    Dim Wsh As Object, MyDoc As String
    Set Wsh = CreateObject("Wscript.Shell")
    MyDoc = Wsh.CurrentDirectory
    MsgBox MyDoc, vbInformation, "Belgelerim"
End Sub

Sub Ozel_Klasorler()
    Dim Wsh As Object, a As String, i As Byte
    Set Wsh = CreateObject("Wscript.Shell")
    With Wsh
        For i = 0 To .SpecialFolders.Count - 1
            a = a & i & "-) " & .SpecialFolders(i) & Chr(10)
        Next i
    End With
    MsgBox a, vbInformation, "::.. Özel Klasörler ..::"
End Sub

Sub Popup_Mesaj()
    Dim WSH As Object
    Set WSH = CreateObject("Wscript.Shell")
    WSH.Popup "Www.ExcelTurkey.Com", 1, "Zeki GÜRSOY", 0
    'Sabit  Değer   Açıklama
    'vbOK     1     OK button
    'vbCancel 2     Cancel button
    'vbAbort  3     Abort button
    'vbRetry  4     Retry button
    'vbIgnore 5     Ignore button
    'vbYes    6     Yes button
    'vbNo     7     No button
End Sub

Sub Popup_Mesaj()
    Dim Wsh As Object
    Set Wsh = CreateObject("Wscript.Shell")
    Wsh.Run """C:\Program Files\Microsoft Office\root\Office16\EXCEL.EXE """ & _
    """C:\Users\user\Desktop\ve-yada fonksiyonların dizi formüllerinde kullanılması.xls""", vbMaximizedFocus, True
    MsgBox "Dosya şimdi açılıyor.", vbInformation
End Sub

Sub Wsh_Exec()
    Dim Wsh As Object
    Set Wsh = CreateObject("Wscript.Shell")
    Set WsExec = Wsh.Exec("Notepad.exe")
    While Not Wsh.AppActivate(WsExec.ProcessID)
        'Program açılana kadar beklet
        DoEvents
    Wend
 
     '*******************************************
     'Programın kapanışını bekleme;
     'Set WsExec = Wsh.Exec("notepad")
     '    Do While WsExec.Status = 0
     '        '"0" çalışan, "1" kapanan programın durumunu ifade eder.
     '        'Program kapanana kadar beklet
     '         DoEvents
     '    Loop
     'MsgBox "Notepad, şimdi kapandı.", vbInformation
     '*********************************************
    
    Wsh.SendKeys "Www.ExcelTurkey.Com"
End Sub

Sub Tus_Gonder()
    Dim Wsh As Object
    Set Wsh = CreateObject("Wscript.Shell")
    Wsh.Run """C:\Program Files\Firebird\Firebird_2_0\bin\isql.exe""", vbMinimizedNoFocus
    Do While WshShell.AppActivate("isql.exe") = False
        'Program görünene kadar beklet...
        DoEvents
    Loop
     'Yeni bir veritabanı oluşturmaya yarayan SQL tuşlarının gönderimi.
    With WshShell
        .SendKeys _
            "CREATE DATABASE 'C:\Test.fdb' USER 'SYSDBA' PASSWORD 'masterkey';" & vbCrLf
        .SendKeys _
            "EXIT;" & vbCrLf
    End With
    MsgBox "Veritabanı oluşturuldu.", vbInformation
End Sub

Sub Reg_Oku()
    Dim Wsh As Object, Reg_Deger As Variant
    Set Wsh = CreateObject("Wscript.Shell")
    Reg_Deger = Wsh.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Notepad\lfCharSet")
    MsgBox Reg_Deger, vbInformation, "Excel"
    'HKEY_CURRENT_USER   = HKCU
    'HKEY_LOCAL_MACHINE  = HKLM
    'HKEY_CLASSES_ROOT   = HKCR
    'HKEY_USERS          = HKEY_USERS
    'HKEY_CURRENT_CONFIG = HKEY_CURRENT_CONFIG
End Sub

Sub Reg_Yaz()
    Dim Wsh As Object
    Set Wsh = CreateObject("Wscript.Shell")
    Wsh.RegWrite "HKEY_CURRENT_USER\Zeki\Zeki", "Excel", "REG_SZ"
    MsgBox "Registry' e değer yazıldı.", vbInformation, "Excel"
End Sub

Sub Reg_Sil()
    Dim Wsh As Object
    Set Wsh = CreateObject("Wscript.Shell")
    'Wsh.RegDelete "HKEY_CURRENT_USER\Zeki\Zeki" ' Değer silme
    Wsh.RegDelete "HKEY_CURRENT_USER\Zeki\" ' Anahtar silme
    MsgBox "Registry' den değer silindi.", vbInformation, "Excel"
End Sub

Sub KisaYol_Dosya()
    Dim Wsh As Object, Desktop As String
    Set Wsh = CreateObject("Wscript.Shell")
    Desktop = Wsh.SpecialFolders("Desktop") & "\"
    Set CShortcut = Wsh.CreateShortcut(Desktop & "Test.lnk")
    With CShortcut
        .TargetPath = "C:\Program Files\Microsoft Office\root\Office16\EXCEL.EXE"
        .WindowStyle = 1    'Tam ekran
        'Icon belirtilmezse hedef uygulamanın iconu görünür.
        'Bir Icon dosyası yerine uygulama da gösterilebilir.
        .IconLocation = "D:\Test.ico"
        .Save
    End With
End Sub

Sub KisaYol_URL()
    Dim Wsh As Object, Desktop As String
    Set Wsh = CreateObject("Wscript.Shell")
    Desktop = Wsh.SpecialFolders("Desktop") & "\"
    Set CShortcut = Wsh.CreateShortcut(Desktop & "Test.url")
    With CShortcut
        .TargetPath = "Www.ExcelTurkey.Com"
        .Save
        MsgBox "'" & .FullName & "' oluşturuldu.", vbInformation
    End With
End Sub

Wsh.Run """C:\Program Files\Microsoft Office\Office16\EXCEL.EXE """ & _

C:\Program Files (x86)\Microsoft Office\root\Office16\EXCEL.EXE