Jump to content
¯\_( ツ)_/¯
  • TAD GROUP are currently hiring penetration testers. Please read the topic in Career Central subforum.
  • Sponsored Ad
georgijl

Visual basic (Excel)!

Recommended Posts

Здравейте имам следния проблем и не мога да го разреша, ако някой може да помогне ще съм много благодарен. Та проблемът е че получавам всеки ден .csv репорти и искам да ги автоматизирам сами да се копират и поставят в един sheet в екселски документ. Само че ми ги поставя хоризонтално от ляво на дясно а не от горе надолу ето и кодът:

Ако някой има някакви идеи да заповяда :) . Благодаря!

Public Sub Sample()
Dim Fl          As Object
Dim Fldr        As Object
Dim FSO         As Object
Dim LngColumn   As Long
Dim WkBk_Dest   As Excel.Workbook
Dim WkBk_Src    As Excel.Workbook
Dim WkSht_Dest  As Excel.Worksheet
Dim WkSht_Src   As Excel.Worksheet

'Using FileSystemObject to get the folder of files
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Fldr = FSO.GetFolder("D:\Tables\")

'Setting a reference to the destination worksheet (i.e. where the
'data we are collecting is going to)
Set WkBk_Dest = ThisWorkbook
Set WkSht_Dest = WkBk_Dest.Worksheets("Merged")

'Look at each file in the folder
For Each Fl In Fldr.Files

    'Is it a xls, xlsx, xlsm, etc...
    If InStr(1, Right(Fl.Name, 5), ".csv") <> 0 Then

        'Get the next free column in our destination
        LngColumn = WkSht_Dest.Cells(1, WkSht_Dest.Columns.Count).End(xlToLeft).Column
        If LngColumn > 1 Then LngColumn = LngColumn + 1

        'Set a reference to the source (note in this case it is simply selected the first worksheet
        Set WkBk_Src = Application.Workbooks.Open(Fl.Path)
        Set WkSht_Src = WkBk_Src.Worksheets(1)

            'Copy the data from source to destination
            WkSht_Src.UsedRange.Copy WkSht_Dest.Cells(1, LngColumn)

        Set WkSht_Src = Nothing
        WkBk_Src.Close 0
        Set WkBk_Src = Nothing
    End If
Next

Set WkSht_Dest = Nothing

Set WkBk_Dest = Nothing
Set Fldr = Nothing
Set FSO = Nothing

End Sub
 

Сподели публикацията


Адрес на коментара
Сподели в други сайтове

Тоя VB много грозен. На мен ми се наложи нещо такова да правя и използвах https://openpyxl.readthedocs.io/en/stable/ python библиотека.

Ако си пренапишеш на python това което ти трябва и пак имаш проблем, сигурно ще може да ти се помогне. 

Сподели публикацията


Адрес на коментара
Сподели в други сайтове

Създайте нов акаунт или се впишете, за да коментирате

За да коментирате, трябва да имате регистрация

Създайте акаунт

Присъединете се към нашата общност. Регистрацията става бързо!

Регистрация на нов акаунт

Вход

Имате акаунт? Впишете се оттук.

Вписване

  • Потребители разглеждащи страницата   0 потребители

    No registered users viewing this page.

×

Important Information

За да посещавате този уебсайт е необходимо да се съгласите с Terms of Use. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.