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 това което ти трябва и пак имаш проблем, сигурно ще може да ти се помогне. 

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


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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Отговорете в темата...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


  • Потребители разглеждащи страницата   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.