Я нашел следующий пакетный скрипт Dos здесь на форуме SF Переименование нескольких файлов в пакетном файле Dos , и он работает точно так, как задумано:)
Моя проблема в том, что я выполняю этоиз сценария Excel VBA и
Я должен построить задержку EG Msgbox в VBA, в противном случае сценарий VBA выполняется быстрее, чем сценарий DOS переименовывает файл, который мне нужен, в результате чегофайл не найден (это делается на лету и по мере необходимости).
В книге Excel открывается лист с именем от 1 до 800. Если я хочу открыть файл 14.csv (согласно названию листа) скрипт dos не сильно поможет, потому что он переименовывает файлы по порядку, поэтому 1,2,3,4,5, а не 1,2,3,4, 14 (или по мере необходимости).
может быть лучше описание:
Я открываю лист, которому автоматически присваивается номер (в данном случае лист 14) - затем я запускаю скрипт vba длянайти файл с конкретным началом в каталоге, т.е. "keyw * .csv" иПереименуйте это, например, в «14.csv», которое, в свою очередь, импортируется на лист.Существует только ОДИН такой файл, который начинает с «keyw * .csv», присутствующего в каталоге до его переименования.
В принципе, как я вижу, у меня есть только выбор другой функции в пакетном файле DOS илидаже лучше, что-то на основе «MoveFile» в макросе VBA, но когда я пытаюсь «MoveFile» в VBA, он не распознает «*».
Каждый раз, когда я загружаю файл, он начинаетсяс "Keywords_blahbla", поэтому мне нужно использовать подстановочный знак, чтобы найти его, чтобы переименовать его.Очевидно, я мог бы легко открыть каталог и щелкнуть по файлу, но я действительно хотел бы автоматизировать весь процесс, чтобы вы могли направить меня в правильном направлении
спасибо
этоПакет DOS, который я использую:
REM DOS FILE
echo на cd \ cd c: \ Keywords \ SOMETHING \
SETLOCAL ENABLEDELAYEDEXPANSION
SET count=3
FOR %%F IN (c:\keywords\SOMETHING\*.csv) DO MOVE "%%~fF" "%%~dpF!count!.csv" & SET /a
count=!count!+1
ENDLOCAL
, и это связанный скрипт VBA:
Dim vardirfull As String
Dim RetVal
Dim varInput As Variant
Dim fso As Object
vardirfull = Left(ThisWorkbook.Name, InStr(1, ThisWorkbook.Name, ".", vbTextCompare) - 1)
vardir = UCase(vardirfull)
varfil = ActiveSheet.Name
If Range("A2") <> "" Then
ActiveSheet.Range("A2:C1050").ClearContents
Selection.Hyperlinks.Delete
'-----------------------------------------
'using VBA input to open the file:
'varInput = InputBox("Please enter the NUMBER/NAME highlited at the bottom of this Worksheet or enter 'new' for a new Worksheet")
'If CStr(varInput) <> CStr(ActiveSheet.Name) Then GoTo MustBeSheetName
'-----------------------------------------
'using the DOS Batch:
'RetVal = Shell("C:\keywords\" & vardir & "\changeto3.bat", 1)
'MsgBox "check1 - C:\keywords\" & vardir & "\" & varfil & ".csv"
'-----------------------------------------
'using VBA to search without opening a dialog:(wildcard is not accepted)
Set fso = CreateObject("Scripting.FileSystemObject")
fso.MoveFile "C:\keywords\" & vardir & "\keyw*.csv", "C:\keywords\" & vardir & "\" & vardir & ".csv"
'MsgBox "pause to allow DOS to fully execute(if used)"
If (fso.FileExists("C:\keywords\" & vardir & "\" & varfil & ".csv")) Then
Set fso = Nothing
GoTo Contin
Else
MsgBox "No such File"
Exit Sub
End If
Contin:
Range("A2:B2").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\keywords\" & vardir & "\" & varfil & ".csv", Destination:=Range("$A$2"))
РЕДАКТИРОВАТЬ 1
Сценарий сообщает об ошибке "требуется постоянное выражение", которую я не понимаю, поскольку переменная "vardir" уже определена
Dim vardirfull As String
vardirfull = Left(ThisWorkbook.Name, InStr(1, ThisWorkbook.Name, ".", vbTextCompare) - 1)
vardir = UCase(vardirfull)
ActiveSheet.Range("A2:C1050").ClearContents
Selection.Hyperlinks.Delete
'-----------------------------------------
Dim sNewFile As String
Dim sh As Worksheet
Dim qt As QueryTable
Dim sConn As String
Const sPATH As String = "C:\magickeys\" & vardir & "\" **'(error:constant expression required**
Const sKEY As String = "keyw"
'I'm not sure how your sheet gets named, so I'm naming
'it explicitly here
Set sh = ActiveSheet
'sh.Name = "14"
sNewFile = sh.Name & ".csv"
'look for 'keyword' file
sOldFile = Dir(sPATH & sKEY & "*.csv")
'if file is found
If Len(sOldFile) > 0 Then
'rename it
Name sPATH & sOldFile As sPATH & sNewFile
End If
РЕДАКТИРОВАТЬ 2: РЕШЕНО
СПАСИБО КРИС:)
Поиграв со сценарием и немного приведя в порядок мою, теперь она полностьюфункционал
Поскольку имя листа уже назначено любому новому листу через бэкэнд, не было необходимости устанавливать имя, но на случай, если кому-то это понравится, я включил и закомментировал вариант ввода, поэтомуВы просто вводите имя листа, а остальное автоматизировано (например,раскомментируйте эти строки).Очевидно, что в конце я не указал точный тип импорта, так как каждый хотел бы импортировать разные строки и изменить другое имя файла, просто изменив переменную "sKEY".
Еще раз спасибо Крис
Sub RenameandImportNewFile()
'Dim varInput As Variant
'varInput = InputBox("Rename this sheet and the File to be imported will be named accordingly or Cancel, vbCancel")
'If varInput = "" Then Exit Sub
'ActiveSheet.Name = varInput
Dim fso As FileSystemObject
Dim Fl As file
Dim vardirfull As String
Dim sPATH As String
Dim sKEY As String
Dim sNewFile As String
vardirfull = Left(ThisWorkbook.Name, InStr(1, ThisWorkbook.Name, ".", vbTextCompare) - 1)
vardir = UCase(vardirfull)
sPATH = "C:\magickeys\" & vardir & "\"
sKEY = "key"
sh = ActiveSheet.Name
sNewFile = sPATH & sh & ".csv"
ActiveSheet.Range("A2:C1050").ClearContents
Selection.Hyperlinks.Delete
'-----------------------------------------
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(sNewFile)) Then
GoTo Contin
Else
MsgBox "The File : " & sNewFile & " will now be created"
End If
sOldFile = sPATH & sKEY & "*.csv"
'------------------------------------------
Set fso = New FileSystemObject
Set Fl = FindFile(fso, "C:\magickeys\" & vardir & "\", "key*.csv")
If Fl Is Nothing Then
MsgBox "No Files Found"
Exit sub
Else
MsgBox "Found " & Fl.Name
If Len(sOldFile) > 0 Then
Name Fl As sNewFile
'------------------------------------------
Contin:
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & sNewFile, Destination:=Range("$A$2"))
'here the rows you want to import
end sub
включить эту функцию после суб
Function FindFile(ByRef fso As FileSystemObject, FolderSpec As String, FileSpec As String) As file
Dim Fld As folder
Dim Fl As file
Set Fld = fso.GetFolder(FolderSpec)
For Each Fl In Fld.Files
If Fl.Name Like FileSpec Then
' return first matching file
Set FindFile = Fl
GoTo Cleanup:
End If
Next
Set FindFile = Nothing
Cleanup:
Set Fl = Nothing
Set Fld = Nothing
Set fso = Nothing
End Function