csv import softwareSvakodnevno imam oko 50-ak csv file-ova koje uvlačim u Excel. Jako me smara da to radim ručno. Imam vb skriptu, ali ona radi samo na 2003, jer je na 2007 izbačena funkcija application.filesearch, a ne znam da je prepravim kako bi radila na Office-u 2007.
Ako neko zna da prepravi ovu skriptu ( koju sam takođe na ovom forumu dobio ), da radi na Office-u 2007, onda mi aplikacija ni ne treba, a ako ne bio bih zahvalan ako bi me neko uputio ka besplatnoj aplikaciji ove namene.
Kao što se vidi iz priloženog koda, delimiter je "|" .
Hvala unapred
Code:
Sub CopyData()
Dim Bazna As Workbook 'Workbook u kojem je macro'
Dim Otvorena As Workbook 'Workbook npr. kumulativno_123.csv'
Dim i As Long
Dim BrRedova As Integer 'br redova u csv
Dim BrKolona As Integer 'br kolona u csv
Dim Putanja As String 'Putanja foldera u kojem se nalaze csv file-ovi'
Putanja = ThisWorkbook.Path
Range("A1").Select
Application.ScreenUpdating = False 'Da ne prikazuje kako otvara csv'
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = Putanja
.Filename = "kumulativno_*" & ".csv"
.SearchSubFolders = False 'nema podfoldera'
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set Bazna = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set Otvorena = Workbooks.Open(.FoundFiles(i))
BrRedova = ActiveSheet.UsedRange.Rows.Count
Otvorena.Worksheets(1).Range("a:a").Select
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Other:=True, OtherChar:="|"
Otvorena.Worksheets(1).Range(Cells(1, 1), Cells(BrRedova, 12)).Select
Selection.Copy
Bazna.Activate
ActiveCell.PasteSpecial
ActiveCell.Offset(BrRedova, 0).Activate
Otvorena.Close savechanges:=False
Next i
End If
End With
End Sub
Sub CopyData()
Dim Bazna As Workbook 'Workbook u kojem je macro'
Dim Otvorena As Workbook 'Workbook npr. kumulativno_123.csv'
Dim i As Long
Dim BrRedova As Integer 'br redova u csv
Dim BrKolona As Integer 'br kolona u csv
Dim Putanja As String 'Putanja foldera u kojem se nalaze csv file-ovi'
Putanja = ThisWorkbook.Path
Range("A1").Select
Application.ScreenUpdating = False 'Da ne prikazuje kako otvara csv'
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.LookIn = Putanja
.Filename = "kumulativno_*" & ".csv"
.SearchSubFolders = False 'nema podfoldera'
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set Bazna = ThisWorkbook
For i = 1 To .FoundFiles.Count
Set Otvorena = Workbooks.Open(.FoundFiles(i))
BrRedova = ActiveSheet.UsedRange.Rows.Count
Otvorena.Worksheets(1).Range("a:a").Select
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Other:=True, OtherChar:="|"
Otvorena.Worksheets(1).Range(Cells(1, 1), Cells(BrRedova, 12)).Select
Selection.Copy
Bazna.Activate
ActiveCell.PasteSpecial
ActiveCell.Offset(BrRedova, 0).Activate
Otvorena.Close savechanges:=False
Next i
End If
End With
End Sub
.::. http://www.mixi.co.sr .::.
