VB script Copy Notepad Ke Excel
Sub ListmyFiles() Dim i As Integer Dim str1, str2, str3, str4 As String i = 0 Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder("C:\Users\vamsi\Desktop\MIOIS") On Error Resume Next For Each myFile In f.Files str1 = myFile.Path str2 = myFile.Name str3 = "TEXT;C:\Users\vamsi\Desktop\MIOIS\" & str2 str4 = Left(str2, Len(str2) - 4) Sheets.Add.Name = str4 With ActiveSheet.QueryTables.Add(Connection:= _ str3, Destination:=Range("$A$1")) .Name = str4 .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 437 .TextFileStartRow = 1 .TextFileParseType = xlFixedWidth .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1) .TextFileFixedColumnWidths = Array(14, 5, 1, 5) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Range("A1:E14").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0
.TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Columns("C:C").Select Selection.Delete Shift:=xlToLeft Range("C1").Select ActiveCell.FormulaR1C1 = "OFFER" Rows("2:2").Select Selection.Delete Shift:=xlUp Range("B1").Select ActiveCell.FormulaR1C1 = "BID" Range("A1:D13").Select Range("B2").Activate With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Columns("C:C").ColumnWidth = 6.14 Next End Sub
.TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Columns("C:C").Select Selection.Delete Shift:=xlToLeft Range("C1").Select ActiveCell.FormulaR1C1 = "OFFER" Rows("2:2").Select Selection.Delete Shift:=xlUp Range("B1").Select ActiveCell.FormulaR1C1 = "BID" Range("A1:D13").Select Range("B2").Activate With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Columns("C:C").ColumnWidth = 6.14 Next End Sub
0 Response to "VB script Copy Notepad Ke Excel"
Post a Comment