Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Ветеран


Сообщения: 27449
Благодарности: 8087

Профиль | Отправить PM | Цитировать


Цитата surrender1:
1. На данный момент имеються ru, com, co.cc, но могут быть любые.
2. Ну на английском пока не встречалось, но может быть и такое. »
В таком случае, я не представляю себе, каким образом можно будет гарантированно распознать конец корневого домена и начало имени. Пока что можно, например, так, на WSH (если у кого-нибудь, особо, гм, продвинутого, нет домена «.рф»):
читать дальше »
Код: Выделить весь код
Option Explicit

Dim strSourceFolder 'в определенной папке
Dim strDestFolder   'Существует каталог, пусть будет d:\какаятопапка.
Dim strNewFolder    'создал каталог (если такого еще не имеется) с именем адреса электронной почты

Dim objFSO
Dim objFile


strSourceFolder = "E:\Песочница\0324"
strDestFolder   = "d:\какаятопапка"

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

If objFSO.FolderExists(strSourceFolder) Then
	If objFSO.FolderExists(strDestFolder) Then
		With WScript.CreateObject("VBScript.RegExp")
			.Pattern = "^(.+@.+?)([А-Яа-я ]+\..*)$"
			
			For Each objFile In objFSO.GetFolder(strSourceFolder).Files
				If .Test(objFile.Name) Then
					With .Execute(objFile.Name)
						strNewFolder = objFSO.BuildPath(strDestFolder, .Item(0).Submatches(0))
						
						If Not objFSO.FolderExists(strNewFolder) Then
							objFSO.CreateFolder strNewFolder
						End If
						
						objFile.Name = .Item(0).Submatches(1)
						objFile.Move strNewFolder & "\"
					End With
				End If
			Next
		End With
	Else
		WScript.Echo "Can't find destination folder [" & strDestFolder & "]."
	End If
Else
	WScript.Echo "Can't find source folder [" & strSourceFolder & "]."
End If

Set objFSO = Nothing

WScript.Quit 0
Это сообщение посчитали полезным следующие участники:

Отправлено: 10:45, 10-10-2013 | #4