VBScript: Сохранение скрипта Script.qvs и QlikView без данных QVW

Пример на VBScript

С помощью скрипта в VBScript можно сохранить все приложения QlikView без данных. Плюс вынести скрипт в текстовый файл QVS.

Почему-то проблема со значком “&” в коде.

Скачать пример (ANSI формат текста): CreateBackUp_QlikView_Apps.vbs

rem === ПЕРЕМЕННЫЕ ===
Dim vToday, targetPath, targetFolder, targetScriptFolder, sourceFolder
Dim oFSO
Dim arrFolders

rem === ОБЪЕКТЫ ===
set Qv = CreateObject("QlikTech.QlikView")
set shell = createobject("wscript.shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")

rem === ЗАДАЕМ ПЕРЕМЕННЫЕ ===
arrFolders = Array("AppManual","Apps1","Apps2","Apps3")
vToday = Date
targetPath = "\\QlikServer\c$\Qlik\Backup\Apps_" &amp; vToday

rem === СОЗДАЕМ ДИРЕКТОРИЮ Path===
  If Not oFSO.FolderExists(targetPath) Then
    oFSO.CreateFolder targetPath
  End If
  
For Each elementFolder In arrFolders
  
  rem === ОПРЕДЕЛЯЕМ ДИРЕКТОРИИ ===
  targetFolder = targetPath &amp; "\" &amp; elementFolder
  sourceFolder = "C:\Qlik\Apps\" &amp; elementFolder &amp; "\"
  targetScriptFolder = targetFolder &amp; "\Scripts\"
  
  
  rem === СОЗДАЕМ ДИРЕКТОРИЮ AppTier ===
  If Not oFSO.FolderExists(targetFolder) Then
    oFSO.CreateFolder targetFolder
  End If
  
  rem === СОЗДАЕМ ДИРЕКТОРИЮ Scripts ===
  If Not oFSO.FolderExists(targetScriptFolder) Then
    oFSO.CreateFolder targetScriptFolder
  End If
  
  rem === В ЦИКЛЕ ОТПРАВЛЯЕМ ПРИЛОЖЕНИЯ БЕЗ ДАННЫХ НА 2 СЕРВЕР В НОВУЮ ПАПКУ ===
  For Each oFile In oFSO.GetFolder(sourceFolder).Files
    If UCase(oFSO.GetExtensionName(oFile.Name)) = "QVW" Then

    success = shell.appactivate("Qlikview - [Start Page]")
    Set docObj = Qv.OpenDoc(oFile,3,false)
    docObj.ClearAll
    docObj.RemoveAllData
    docObj.SaveAs targetFolder &amp; "\" &amp; oFile.Name
    
    rem === ПИШЕМ SCRIPT ФАЙЛ QVS ===
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set qvsFile = fs.CreateTextFile(targetScriptFolder &amp; oFSO.GetBaseName(oFile.Name) &amp; ".qvs", 2, True)
    qvsFile.Write(docObj.GetProperties.Script)
    qvsFile.Close

    docObj.CloseDoc
    
    rem === ОПЦИЯ ДЛЯ ТЕСТИРОВАНИЯ - по одному qvw в каждой директории ===
    rem Exit For

    End if
  Next
  
Next

Qv.Quit

rem === ПЕРЕМЕННЫЕ ===

Dim vToday, targetPath, targetFolder, targetScriptFolder, sourceFolder

Dim oFSO

Dim arrFolders

rem === ОБЪЕКТЫ ===

set Qv = CreateObject("QlikTech.QlikView")

set shell = createobject("wscript.shell")

Set oFSO = CreateObject("Scripting.FileSystemObject")

rem === ЗАДАЕМ ПЕРЕМЕННЫЕ ===

arrFolders = Array("AppManual","Apps1","Apps2","Apps3")

vToday = Date

targetPath = "\\QlikServer\c$\Qlik\Backup\Apps_" & vToday

rem === СОЗДАЕМ ДИРЕКТОРИЮ Path===

If Not oFSO.FolderExists(targetPath) Then

oFSO.CreateFolder targetPath

End If

For Each elementFolder In arrFolders

rem === ОПРЕДЕЛЯЕМ ДИРЕКТОРИИ ===

targetFolder = targetPath & "\" & elementFolder

sourceFolder = "C:\Qlik\Apps\" & elementFolder & "\"

targetScriptFolder = targetFolder & "\Scripts\"

rem === СОЗДАЕМ ДИРЕКТОРИЮ AppTier ===

If Not oFSO.FolderExists(targetFolder) Then

oFSO.CreateFolder targetFolder

End If

rem === СОЗДАЕМ ДИРЕКТОРИЮ Scripts ===

If Not oFSO.FolderExists(targetScriptFolder) Then

oFSO.CreateFolder targetScriptFolder

End If

rem === В ЦИКЛЕ ОТПРАВЛЯЕМ ПРИЛОЖЕНИЯ БЕЗ ДАННЫХ НА 2 СЕРВЕР В НОВУЮ ПАПКУ ===

For Each oFile In oFSO.GetFolder(sourceFolder).Files

If UCase(oFSO.GetExtensionName(oFile.Name)) = "QVW" Then

success = shell.appactivate("Qlikview - [Start Page]")

Set docObj = Qv.OpenDoc(oFile,3,false)

docObj.ClearAll

docObj.RemoveAllData

docObj.SaveAs targetFolder & "\" & oFile.Name

rem === ПИШЕМ SCRIPT ФАЙЛ QVS ===

Set fs = CreateObject("Scripting.FileSystemObject")

Set qvsFile = fs.CreateTextFile(targetScriptFolder & oFSO.GetBaseName(oFile.Name) & ".qvs", 2, True)

qvsFile.Write(docObj.GetProperties.Script)

qvsFile.Close

docObj.CloseDoc

rem === ОПЦИЯ ДЛЯ ТЕСТИРОВАНИЯ - по одному qvw в каждой директории ===

rem Exit For

End if

Qv.Quit

Пример на VB.NET Visual Studio 2018

Module Module1

    Sub Main()

        '=== ОБЪЯВЛЯЕМ ПЕРЕМЕННЫЕ ===
        Dim fi As Object
        Dim extn As String, fileName As String

        Dim vToday, targetPath, targetFolder, targetScriptFolder, sourceFolder
        Dim arrFolders As Array
        Dim Qv As Object, Shell As Object, oFSO As Object, docObj As Object, fs As Object, qvsFile As Object
        Dim success As Object

        '=== СОЗДАЕМ ОБЪЕКТЫ, КОТОРЫЕ В ДАЛЬНЕЙШЕМ БУДЕМ ИСПОЛЬЗОВАТЬ ===

        Qv = CreateObject("QlikTech.QlikView")
        Shell = CreateObject("wscript.shell")
        oFSO = CreateObject("Scripting.FileSystemObject")

        '=== ЗАДАЕМ ПЕРЕМЕННЫЕ ===
        'arrFolders = {"AppDataPublic","AppManual","AppTelegram","AppTier1","AppTier2","AppTier3","AppTier4","AppTierNP","Служебные"}
        arrFolders = {"AppDataPublic", "AppManual", "AppTelegram", "AppTier1", "AppTier2", "AppTier3", "AppTier4", "AppTierNP", "Служебные"}
        vToday = Today
        targetPath = "\\Server-qv2\c$\QVProject\QVBackup\SERVER-QV\QVApp_" &amp; vToday

        '=== СОЗДАЕМ ДИРЕКТОРИЮ Path===
        If Not oFSO.FolderExists(targetPath) Then
            oFSO.CreateFolder(targetPath)
        End If

        For Each elementFolder In arrFolders

            '=== ОПРЕДЕЛЯЕМ ДИРЕКТОРИИ ===
            targetFolder = targetPath &amp; "\" &amp; elementFolder
            sourceFolder = "C:\QVProject\QVApp\" &amp; elementFolder &amp; "\"
            targetScriptFolder = targetFolder &amp; "\Scripts\"


            '=== СОЗДАЕМ ДИРЕКТОРИЮ AppTier ===
            If Not oFSO.FolderExists(targetFolder) Then
                oFSO.CreateFolder(targetFolder)
            End If

            '=== СОЗДАЕМ ДИРЕКТОРИЮ Scripts ===
            If Not oFSO.FolderExists(targetScriptFolder) Then
                oFSO.CreateFolder(targetScriptFolder)
            End If

            '=== В ЦИКЛЕ ОТПРАВЛЯЕМ ПРИЛОЖЕНИЯ БЕЗ ДАННЫХ НА 2 СЕРВЕР В НОВУЮ ПАПКУ ===
            For Each oFile In oFSO.GetFolder(sourceFolder).Files


                fi = New IO.FileInfo(oFile.Name)
                extn = fi.Extension
                fileName = Replace(fi.Name, ".qvw", "")

                If extn.ToLower() = ".qvw" Then

                    'success = Shell.appactivate("Qlikview - [Start Page]")
                    docObj = Qv.OpenDoc(oFile, 3, False)
                    docObj.ClearAll
                    docObj.RemoveAllData
                    docObj.SaveAs(targetFolder &amp; "\" &amp; oFile.Name)

                    '=== ПИШЕМ SCRIPT ФАЙЛ QVS ===
                    fs = CreateObject("Scripting.FileSystemObject")
                    qvsFile = fs.CreateTextFile(targetScriptFolder &amp; fileName &amp; ".qvs", 2, True)
                    qvsFile.Write(docObj.GetProperties.Script)
                    qvsFile.Close

                    docObj.CloseDoc

                    '=== ОПЦИЯ ДЛЯ ТЕСТИРОВАНИЯ - по одному qvw в каждой директории ===
                    'Exit For


                End If
            Next

        Next

        Qv.Quit


    End Sub

End Module

Module Module1

Sub Main()

'=== ОБЪЯВЛЯЕМ ПЕРЕМЕННЫЕ ===

Dim fi As Object

Dim extn As String, fileName As String

Dim vToday, targetPath, targetFolder, targetScriptFolder, sourceFolder

Dim arrFolders As Array

Dim Qv As Object, Shell As Object, oFSO As Object, docObj As Object, fs As Object, qvsFile As Object

Dim success As Object

'=== СОЗДАЕМ ОБЪЕКТЫ, КОТОРЫЕ В ДАЛЬНЕЙШЕМ БУДЕМ ИСПОЛЬЗОВАТЬ ===

Qv = CreateObject("QlikTech.QlikView")

Shell = CreateObject("wscript.shell")

oFSO = CreateObject("Scripting.FileSystemObject")

'=== ЗАДАЕМ ПЕРЕМЕННЫЕ ===

'arrFolders = {"AppDataPublic","AppManual","AppTelegram","AppTier1","AppTier2","AppTier3","AppTier4","AppTierNP","Служебные"}

arrFolders = {"AppDataPublic", "AppManual", "AppTelegram", "AppTier1", "AppTier2", "AppTier3", "AppTier4", "AppTierNP", "Служебные"}

vToday = Today

targetPath = "\\Server-qv2\c$\QVProject\QVBackup\SERVER-QV\QVApp_" & vToday

'=== СОЗДАЕМ ДИРЕКТОРИЮ Path===

If Not oFSO.FolderExists(targetPath) Then

oFSO.CreateFolder(targetPath)

End If

For Each elementFolder In arrFolders

'=== ОПРЕДЕЛЯЕМ ДИРЕКТОРИИ ===

targetFolder = targetPath & "\" & elementFolder

sourceFolder = "C:\QVProject\QVApp\" & elementFolder & "\"

targetScriptFolder = targetFolder & "\Scripts\"

'=== СОЗДАЕМ ДИРЕКТОРИЮ AppTier ===

If Not oFSO.FolderExists(targetFolder) Then

oFSO.CreateFolder(targetFolder)

End If

'=== СОЗДАЕМ ДИРЕКТОРИЮ Scripts ===

If Not oFSO.FolderExists(targetScriptFolder) Then

oFSO.CreateFolder(targetScriptFolder)

End If

'=== В ЦИКЛЕ ОТПРАВЛЯЕМ ПРИЛОЖЕНИЯ БЕЗ ДАННЫХ НА 2 СЕРВЕР В НОВУЮ ПАПКУ ===

For Each oFile In oFSO.GetFolder(sourceFolder).Files

fi = New IO.FileInfo(oFile.Name)

extn = fi.Extension

fileName = Replace(fi.Name, ".qvw", "")

If extn.ToLower() = ".qvw" Then

'success = Shell.appactivate("Qlikview - [Start Page]")

docObj = Qv.OpenDoc(oFile, 3, False)

docObj.ClearAll

docObj.RemoveAllData

docObj.SaveAs(targetFolder & "\" & oFile.Name)

'=== ПИШЕМ SCRIPT ФАЙЛ QVS ===

fs = CreateObject("Scripting.FileSystemObject")

qvsFile = fs.CreateTextFile(targetScriptFolder & fileName & ".qvs", 2, True)

qvsFile.Write(docObj.GetProperties.Script)

qvsFile.Close

docObj.CloseDoc

'=== ОПЦИЯ ДЛЯ ТЕСТИРОВАНИЯ - по одному qvw в каждой директории ===

'Exit For

End If

Qv.Quit

End Sub

End Module

Пример как распилить 1 выгруженный скрипт по 1 приложению на несколько скриптов .qvs в VB.NET Visual Studio

Module Module1

    Sub Main()

        Dim sourceObjFile, strLine, NewFileName, FileCount, newFile, newIncludeFile
        Dim oFSO
        Dim fi As Object
        Dim extn As String, fileName As String

        Dim sourcePath, sourceArrayFolders, sourceFolder
        Dim targetPath, targetAppTierFolder, targetAppFolder

        Dim objStreamUTF8

        sourcePath = "\\Server-qv2\c$\QVProject\QVBackup\SERVER-QV\QVApp_06.12.2019\"
        sourceArrayFolders = {"AppDataPublic", "AppManual", "AppTelegram", "AppTier1", "AppTier2", "AppTier3", "AppTier4", "AppTierNP", "Служебные"}

        targetPath = "C:\QVProject\QVScript\"

        oFSO = CreateObject("Scripting.FileSystemObject")

        For Each elementFolder In sourceArrayFolders
            sourceFolder = sourcePath &amp; elementFolder &amp; "\Scripts"

            '1. Создаем папку уровня AppTier в targetPath
            targetAppTierFolder = targetPath &amp; elementFolder

            '=== СОЗДАЕМ ДИРЕКТОРИЮ СЛОЯ ===
            If Not oFSO.FolderExists(targetAppTierFolder) Then
                oFSO.CreateFolder(targetAppTierFolder)
            End If

            '2. В цикле проходим по всем скриптам-приложениям.qvs в директории sourceFolder 
            '   и создаем отдельные подпапки на каждое приложение
            For Each oFile In oFSO.GetFolder(sourceFolder).Files


                fi = New IO.FileInfo(oFile.Name)
                extn = fi.Extension
                fileName = Replace(fi.Name, ".qvs", "")



                If extn.ToLower() = ".qvs" Then

                    'Название директории-приложения
                    targetAppFolder = targetAppTierFolder &amp; "\" &amp; fileName

                    '=== СОЗДАЕМ ДИРЕКТОРИЮ ПРИЛОЖЕНИЯ ===
                    If Not oFSO.FolderExists(targetAppFolder) Then
                        oFSO.CreateFolder(targetAppFolder)
                    End If

                    sourceObjFile = oFSO.OpenTextFile(oFile, 1, False, -1)
                    newIncludeFile = oFSO.CreateTextFile(targetAppFolder &amp; "\0. ListOfAllScriptsWith_MustInclude.qvs", True, False)

                    NewFileName = ""
                    FileCount = 0

                    Do Until sourceObjFile.AtEndOfStream
                        strLine = sourceObjFile.readline
                        If Left(strLine, 7) = "///$tab" Then

                            If Len(NewFileName) &gt; 0 Then
                                With objStreamUTF8
                                    .SaveToFile(targetAppFolder &amp; "\" &amp; NewFileName, 2)
                                    .Flush
                                    .Close
                                End With
                            End If

                            FileCount = FileCount + 1

                            NewFileName = Replace(strLine, "///$tab", "")
                            NewFileName = Replace(NewFileName, "\", "")
                            NewFileName = Replace(NewFileName, "/", "")
                            NewFileName = Replace(NewFileName, "*", "")
                            NewFileName = Replace(NewFileName, "!", "")
                            NewFileName = Replace(NewFileName, "?", "")
                            NewFileName = Replace(NewFileName, "&gt;", "")
                            NewFileName = Replace(NewFileName, "&lt;", "")
                            NewFileName = Replace(NewFileName, "✽", "")
                            NewFileName = Replace(NewFileName, "★", "")
                            NewFileName = Replace(NewFileName, "⇨", "")
                            NewFileName = Replace(NewFileName, "⇦", "")
                            NewFileName = Replace(NewFileName, """", "")
                            NewFileName = FileCount &amp; ". " &amp; Trim(NewFileName) &amp; ".qvs"

                            REM MsgBox(NewFileName) rem Отладка

                            'newFile = oFSO.CreateTextFile(targetAppFolder &amp; "\" &amp; NewFileName, 2, True)
                            objStreamUTF8 = CreateObject("ADODB.Stream")
                            With objStreamUTF8
                                .CharSet = "UTF-8"
                                .Type = 2
                                .Open
                            End With

                            newIncludeFile.WriteLine("$(Must_Include=" &amp; targetAppFolder &amp; "\" &amp; NewFileName &amp; ");")
                        Else
                            'newFile.WriteLine(strLine)
                            With objStreamUTF8
                                .WriteText(strLine)
                                .WriteText(vbCrLf)
                            End With
                        End If
                    Loop

                    objStreamUTF8.SaveToFile(targetAppFolder &amp; "\" &amp; NewFileName, 2)
                    objStreamUTF8.Flush
                    objStreamUTF8.Close

                    sourceObjFile.Close
                    newIncludeFile.Close

                End If

            Next

        Next

    End Sub


End Module

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

Module Module1

Sub Main()

Dim sourceObjFile, strLine, NewFileName, FileCount, newFile, newIncludeFile

Dim oFSO

Dim fi As Object

Dim extn As String, fileName As String

Dim sourcePath, sourceArrayFolders, sourceFolder

Dim targetPath, targetAppTierFolder, targetAppFolder

Dim objStreamUTF8

sourcePath = "\\Server-qv2\c$\QVProject\QVBackup\SERVER-QV\QVApp_06.12.2019\"

sourceArrayFolders = {"AppDataPublic", "AppManual", "AppTelegram", "AppTier1", "AppTier2", "AppTier3", "AppTier4", "AppTierNP", "Служебные"}

targetPath = "C:\QVProject\QVScript\"

oFSO = CreateObject("Scripting.FileSystemObject")

For Each elementFolder In sourceArrayFolders

sourceFolder = sourcePath & elementFolder & "\Scripts"

'1. Создаем папку уровня AppTier в targetPath

targetAppTierFolder = targetPath & elementFolder

'=== СОЗДАЕМ ДИРЕКТОРИЮ СЛОЯ ===

If Not oFSO.FolderExists(targetAppTierFolder) Then

oFSO.CreateFolder(targetAppTierFolder)

End If

'2. В цикле проходим по всем скриптам-приложениям.qvs в директории sourceFolder

' и создаем отдельные подпапки на каждое приложение

For Each oFile In oFSO.GetFolder(sourceFolder).Files

fi = New IO.FileInfo(oFile.Name)

extn = fi.Extension

fileName = Replace(fi.Name, ".qvs", "")

If extn.ToLower() = ".qvs" Then

'Название директории-приложения

targetAppFolder = targetAppTierFolder & "\" & fileName

'=== СОЗДАЕМ ДИРЕКТОРИЮ ПРИЛОЖЕНИЯ ===

If Not oFSO.FolderExists(targetAppFolder) Then

oFSO.CreateFolder(targetAppFolder)

End If

sourceObjFile = oFSO.OpenTextFile(oFile, 1, False, -1)

newIncludeFile = oFSO.CreateTextFile(targetAppFolder & "\0. ListOfAllScriptsWith_MustInclude.qvs", True, False)

NewFileName = ""

FileCount = 0

Do Until sourceObjFile.AtEndOfStream

strLine = sourceObjFile.readline

If Left(strLine, 7) = "///$tab" Then

If Len(NewFileName) > 0 Then

With objStreamUTF8

.SaveToFile(targetAppFolder & "\" & NewFileName, 2)

.Flush

.Close

End With

End If

FileCount = FileCount + 1

NewFileName = Replace(strLine, "///$tab", "")

NewFileName = Replace(NewFileName, "\", "")

NewFileName = Replace(NewFileName, "/", "")

NewFileName = Replace(NewFileName, "*", "")

NewFileName = Replace(NewFileName, "!", "")

NewFileName = Replace(NewFileName, "?", "")

NewFileName = Replace(NewFileName, ">", "")

NewFileName = Replace(NewFileName, "<", "")

NewFileName = Replace(NewFileName, "✽", "")

NewFileName = Replace(NewFileName, "★", "")

NewFileName = Replace(NewFileName, "⇨", "")

NewFileName = Replace(NewFileName, "⇦", "")

NewFileName = Replace(NewFileName, """", "")

NewFileName = FileCount & ". " & Trim(NewFileName) & ".qvs"

REM MsgBox(NewFileName) rem Отладка

'newFile = oFSO.CreateTextFile(targetAppFolder & "\" & NewFileName, 2, True)

objStreamUTF8 = CreateObject("ADODB.Stream")

With objStreamUTF8

.CharSet = "UTF-8"

.Type = 2

.Open

End With

newIncludeFile.WriteLine("$(Must_Include=" & targetAppFolder & "\" & NewFileName & ");")

Else

'newFile.WriteLine(strLine)

With objStreamUTF8

.WriteText(strLine)

.WriteText(vbCrLf)

End With

End If

Loop

objStreamUTF8.SaveToFile(targetAppFolder & "\" & NewFileName, 2)

objStreamUTF8.Flush

objStreamUTF8.Close

sourceObjFile.Close

newIncludeFile.Close

End If

End Sub

End Module

0 0 голос

Рейтинг статьи

Пример на VBScript

Пример на VB.NET Visual Studio 2018

Пример как распилить 1 выгруженный скрипт по 1 приложению на несколько скриптов .qvs в VB.NET Visual Studio

Related posts: